| ︙ | | | ︙ | |
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)
*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))
|
|
|
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)
*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
|
(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
;;
(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)))
|
>
|
>
>
>
>
>
|
|
|
|
|
|
>
|
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 -- 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 *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
|
(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
(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
|
|
|
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 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
|
(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)
(begin
(full-runconfigs-read) ;; cache the run config
(launch:cache-config)) ;; do not cache here - need to be sure runconfigs is processed
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! keys (keys:config-get-fields *configdat*))
|
|
|
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)
(begin
(full-runconfigs-read) ;; cache the run config
(launch:cache-config)) ;; do not cache here - need to be sure runconfigs is processed
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! keys (keys:config-get-fields *configdat*))
|
| ︙ | | | ︙ | |