Megatest

Changes On Branch v1.64-bb1
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch v1.64-bb1 Excluding Merge-Ins

This is equivalent to a diff from a81649fabf to b1b733f324

2017-04-07
23:41
Added nice report generator (thanks to excellent suggestion from Steve Osugi) check-in: f5d0f037cc user: matt tags: v1.64
2017-04-06
18:26
Added constraining of area based on rules in trigger spec Closed-Leaf check-in: 386eb32caa user: mrwellan tags: v1.64-area-support-trigger-spec
14:19
merging mainline Closed-Leaf check-in: b1b733f324 user: bjbarcla tags: v1.64-bb1
14:17
v1.64-bb1 check-in: 91c7fb7326 user: bjbarcla tags: v1.64-bb1
11:45
Consolidating some stuff back on v1.64 check-in: a81649fabf user: mrwellan tags: v1.64, v1.6403
11:20
Capturing merge of misc-changes-please-integrate into v1.64-envdebug check-in: e62592f0fe user: mrwellan tags: v1.64-envdebug
2017-03-29
11:03
added unlock_db.sh to utils check-in: fd47a3e816 user: bjbarcla tags: v1.64

Modified common.scm from [675cf742a5] to [d40a0cdfdd]. 

1686
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697

1698
1699
1700
1701
1702
1703
1704

1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696

1697
1698
1699
1700
1701
1702
1703
1704







-
+



-
+








;; E N V I R O N M E N T   V A R S
;;======================================================================
(define (bb-check-path #!key (msg "check-path: "))
  (let ((path (or (get-environment-variable "PATH") "none")))
    (debug:print-info 0 *default-log-port* (conc msg" : $PATH="path))
    (if (string-match "^.*/isoenv-core/.*" path)
        (debug:print-error 0 *default-log-port* (conc msg" : !!ISOENV PRESENT!!")) ;; remove for prod
        (debug:print-info 1 *default-log-port* (conc msg" : **no isoenv present**")))))
        (debug:print-info 0 *default-log-port* (conc msg" : **no isoenv present**")))))

	      
(define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR" "MAKEFLAGS" "MAKEF" "MAKEOVERRIDES")))
  ;;(bb-check-path msg: "save-environment-as-files entry")
  (bb-check-path msg: "save-environment-as-files entry")
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:,.\\/%$]"))
	(mungeval (lambda (val)
		    (cond
		     ((eq? val #t) "") ;; convert #t to empty string
		     ((eq? val #f) #f) ;; convert #f to itself (still thinking about this one
		     (else val)))))

Modified launch.scm from [b1aa4537fd] to [3ee6726844]. 

403
404
405
406
407
408
409
410

411
412
413
414
415
416
417

403
404
405
406
407
408
409

410
411
412
413
414
415
416
417







-
+








    (tests:update-central-meta-info run-id test-id (get-cpu-load) (get-df (current-directory))(calc-minutes) #f #f))) ;; NOTE: Checking twice for keep-going is intentional


(define (launch:execute encoded-cmd)
  (let* ((cmdinfo    (common:read-encoded-string encoded-cmd))
	 (tconfigreg #f))
    (setenv "MT_CMDINFO" encoded-cmd)
    ;;(bb-check-path msg: "launch:execute incoming")
    (bb-check-path msg: "launch:execute incoming")
    (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed)
	;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1))
	(let* ((testpath  (assoc/default 'testpath  cmdinfo))  ;; testpath is the test spec area
	       (top-path  (assoc/default 'toppath   cmdinfo))
	       (work-area (assoc/default 'work-area cmdinfo))  ;; work-area is the test run area
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))

591
592
593
594
595
596
597
598
599


600
601
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616

591
592
593
594
595
596
597


598
599
600
601
602
603
604
605
606
607
608

609
610
611
612
613
614
615
616







-
-
+
+









-
+








					  (val (cadr varval)))
				      (if (and (string? var)(string? val))
					  (begin
					    (setenv var (config:eval-string-in-environment val))) ;; val)
					  (debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val))))
				  (configf:get-section rconfig section)))
		      (list "default" target)))
          ;;(bb-check-path msg: "launch:execute post block 1")

          (bb-check-path msg: "launch:execute post block 1")
          
	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))
	    (if (or (file-exists? work-area)
		    (> count 10))
		(change-directory work-area)
		(begin
		  (debug:print 0 *default-log-port* "INFO: Not starting job yet - directory " work-area " not found")
		  (thread-sleep! 10)
		  (loop (+ count 1)))))
          ;;(bb-check-path msg: "launch:execute post block 1.5")
          (bb-check-path msg: "launch:execute post block 1.5")
	  ;; (change-directory work-area) 
	  (set! keyvals    (keys:target->keyval keys target))
	  ;; apply pre-overrides before other variables. The pre-override vars must not
	  ;; clobbers things from the official sources such as megatest.config and runconfigs.config
	  (if (string? set-vars)
	      (let ((varpairs (string-split set-vars ",")))
		(debug:print 4 *default-log-port* "varpairs: " varpairs)

638
639
640
641
642
643
644
645

646
647
648

649
650
651
652
653
654
655
656

657
658

659
660

661
662

663
664
665
666
667
668
669

638
639
640
641
642
643
644

645

646

647
648
649
650
651
652
653
654

655
656

657
658

659
660

661
662
663
664
665
666
667
668







-
+
-

-
+







-
+

-
+

-
+

-
+








	      (list  "MT_ITEM_INFO" (conc itemdat))
	      (list  "MT_ITEMPATH"  item-path)
	      (list  "MT_RUNNAME"   runname)
	      (list  "MT_MEGATEST"  megatest)
	      (list  "MT_TARGET"    target)
	      (list  "MT_LINKTREE"  (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))
	      (list  "MT_TESTSUITENAME" (common:get-testsuite-name))))
          ;;(bb-check-path msg: "launch:execute post block 3")
          (bb-check-path msg: "launch:execute post block 3")

	  (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path)))
          ;;(bb-check-path msg: "launch:execute post block 4")
          (bb-check-path msg: "launch:execute post block 4")
	  ;; (change-directory top-path)
	  ;; Can setup as client for server mode now
	  ;; (client:setup)

	  
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
          ;;(bb-check-path msg: "launch:execute post block 41")
          (bb-check-path msg: "launch:execute post block 411")
	  (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals)
          ;;(bb-check-path msg: "launch:execute post block 42")
          (bb-check-path msg: "launch:execute post block 42")
	  (set-item-env-vars itemdat)
          ;;(bb-check-path msg: "launch:execute post block 43")
          (bb-check-path msg: "launch:execute post block 42")
	  (save-environment-as-files "megatest")
          ;;(bb-check-path msg: "launch:execute post block 44")
          (bb-check-path msg: "launch:execute post block 44")
	  ;; open-run-close not needed for test-set-meta-info
	  ;; (tests:set-full-meta-info #f test-id run-id 0 work-area)
	  ;; (tests:set-full-meta-info test-id run-id 0 work-area)
	  (tests:set-full-meta-info #f test-id run-id 0 work-area 10)

	  ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here

Modified runs.scm from [d97eca7b82] to [fe26303692]. 

49
50
51
52
53
54
55
56

57
58
59
60
61
62
63

49
50
51
52
53
54
55

56
57
58
59
60
61
62
63







-
+








  hed tal reg reruns  test-record
  test-name item-path jobgroup
  waitons testmode  newtal itemmaps prereqs-not-met)

;; set up needed environment variables given a run-id and optionally a target, itempath etc.
;;
(define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f))
  ;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
  (bb-check-path msg: "runs:set-megatest-env-vars entry")
  (let* ((target    (or intarget 
			(common:args-get-target)
			(get-environment-variable "MT_TARGET")))
	 (keys      (if inkeys    inkeys    (rmt:get-keys)))
	 (keyvals   (if inkeyvals inkeyvals (keys:target->keyval keys target)))
	 (vals      (hash-table-ref/default *env-vars-by-run-id* run-id #f))
	 (link-tree (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))

83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

109
110


111
112
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

109
110

111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







+


















-
+

-
+
+









-
+








     (lambda (key val)
       (debug:print 2 *default-log-port* "setenv " key " " val)
       (safe-setenv key val)))
    ;;(bb-check-path msg: "runs:set-megatest-env-vars block 1")
    ;;(BB> "*env-vars-by-run-id*/runid("run-id" vals="(hash-table->alist vals))

    (if (not (get-environment-variable "MT_TARGET"))(setenv "MT_TARGET" target))
    (bb-check-path msg: "runs:set-megatest-env-vars block 1")
    ;; we had a case where there was an exception generated by the hash-table-ref
    ;; due to *configdat* being #f Adding a handle and exit
    (let fatal-loop ((count 0)) 
      (handle-exceptions
	  exn
	  (let ((call-chain (get-call-chain))
		(msg        ((condition-property-accessor 'exn 'message) exn)))
	    (if (< count 5)
		(begin ;; this call is colliding, do some crude stuff to fix it.
		  (debug:print 0 *default-log-port* "ERROR: *configdat* was inaccessible! This should never happen. Retry #" count)
		  (launch:setup force-reread: #t)
		  (fatal-loop (+ count 1)))
		(begin
		  (debug:print 0 *default-log-port* "FATAL: *configdat* was inaccessible! This should never happen. Retried " count " times. Message: " msg)
		  (debug:print 0 *default-log-port* "Call chain:")
		  (with-output-to-port *default-log-port*
		    (lambda ()(pp call-chain)))
		  (exit 1))))
          ;;(bb-check-path msg: "runs:set-megatest-env-vars block 1.5")
          (bb-check-path msg: "runs:set-megatest-env-vars block 1.5")
          (alist->env-vars (hash-table-ref/default *configdat* "env-override" '())))) ;;;; environment is tainted HERE in this let block.
    ;;(bb-check-path msg: "runs:set-megatest-env-vars block 2")
    (bb-check-path msg: "runs:set-megatest-env-vars block 2")
    
    ;; Lets use this as an opportunity to put MT_RUNNAME in the environment
    (let ((runname  (if inrunname inrunname (rmt:get-run-name-from-id run-id))))
      (if runname
	  (setenv "MT_RUNNAME" runname)
	  (debug:print-error 0 *default-log-port* "no value for runname for id " run-id)))
    (setenv "MT_RUN_AREA_HOME" *toppath*)
    ;; if a testname and itempath are available set the remaining appropriate variables
    (if testname (setenv "MT_TEST_NAME" testname))
    (if itempath (setenv "MT_ITEMPATH"  itempath))
    ;;(bb-check-path msg: "runs:set-megatest-env-vars block 3")
    (bb-check-path msg: "runs:set-megatest-env-vars block 3")
    (if (and testname link-tree)
	(setenv "MT_TEST_RUN_DIR" (conc (getenv "MT_LINKTREE")  "/"
					(getenv "MT_TARGET")    "/"
					(getenv "MT_RUNNAME")   "/"
					(getenv "MT_TEST_NAME")
					(if (and itempath
						 (not (equal? itempath "")))

This page was generated in about 0.128s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00