Megatest

Diff
Login

Differences From Artifact [935b1bd2d6]:

To Artifact [62ed47157d]:


38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52







-
+







;; This is the *new* methodology. One record to inform them and in the chaos, organise them.
;;
;; NOT YET UTILIZED
;;
(define (runs:create-run-record)
  (let* ((mconfig      (if *configdat*
		           *configdat*
		           (if (launch:setup-for-run)
		           (if (launch:setup)
		               *configdat*
		               (begin
		                 (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting")
		                 (exit 1)))))
	  (runrec      (runs:runrec-make-record))
	  (target      (common:args-get-target))
	  (runname     (common:args-get-runname))
71
72
73
74
75
76
77

78

79





80
81
82
83
84
85







86
87
88
89
90
91
92
71
72
73
74
75
76
77
78

79
80
81
82
83
84
85






86
87
88
89
90
91
92
93
94
95
96
97
98
99







+
-
+

+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+







    (setenv "MT_TARGET"  target)
    (setenv "MT_TESTSUITENAME" (common:get-testsuite-name))
    (set! envdat (append 
		  envdat
		  (list (list "MT_RUN_AREA_HOME" toppath)
			(list "MT_RUNNAME"       runname)
			(list "MT_TARGET"        target))))
    
    ;; Now can read the runconfigs file
    ;; Now can read the runconfigs file -- can replace this with call to launch:setup?
    ;; 
    ;; This block should be ok to remove - just keep the set of runconfig
    ;; 
    (if (not (eq? *configstatus* 'fulldata))
	(begin
	  (debug:print 0 "Processing runconfigs.config again...")
    (set! runconfig (read-config (conc  *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))
    (if (not (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f))
	(begin
	  (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
	  (if db (sqlite3:finalize! db))
	  (exit 1)))
	  (set! runconfig (read-config (conc  *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))
	  (if (not (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f))
	      (begin
		(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
		(if db (sqlite3:finalize! db))
		(exit 1))))
	(set! runconfig *runconfigdat*))
    ;; Now have runconfigs data loaded, set environment vars

    ;; Only now can we calculate the testpatt
    (set! testpatt (common:args-get-testpatt runconfig))
    
    (for-each (lambda (section)
		(for-each (lambda (varval)
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
231
232
233
234
235
236
237

238
239
240
241
242
243
244
245







-
+







	  (list (not can-not-run-more) num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit)))))


;;  test-names: Comma separated patterns same as test-patts but used in selection 
;;              of tests to run. The item portions are not respected.
;;              FIXME: error out if /patt specified
;;            
(define (runs:run-tests target runname test-patts user flags #!key (run-count 3)) ;; test-names
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
  (let* ((keys               (keys:config-get-fields *configdat*))
	 (keyvals            (keys:target->keyval keys target))
	 (run-id             (rmt:register-run keyvals runname "new" "n/a" user))  ;;  test-name)))
	 (deferred          '()) ;; delay running these since they have a waiton clause
	 (runconfigf         (conc  *toppath* "/runconfigs.config"))
	 (test-records       (make-hash-table))
	 ;; need to process runconfigs before generating these lists
1778
1779
1780
1781
1782
1783
1784
1785

1786
1787
1788
1789
1790
1791
1792
1793
1785
1786
1787
1788
1789
1790
1791

1792

1793
1794
1795
1796
1797
1798
1799







-
+
-







      (exit 3))
     ((not runname)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname")
      (exit 3))
     (else
      (let (;; (db   #f)
	    (keys #f))
	(if (launch:setup-for-run)
	(if (not (launch:setup))
	    (launch:cache-config)
	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(set! keys (keys:config-get-fields *configdat*))
	;; have enough to process -target or -reqtarg here
	(if (args:get-arg "-reqtarg")
	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL