| ︙ | | | ︙ | |
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
*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))
(testpatt (common:args-get-testpatt))
;; (args-testpatt (or (args:get-arg "-testpatt")
;; (args:get-arg "-runtests")))
;; (testpatt (or (and (equal? args-testpatt "%")
;; (getenv "TESTPATT"))
;; args-testpatt))
(keys (keys:config-get-fields mconfig))
(keyvals (keys:target->keyval keys target))
(toppath *toppath*)
(envdat keyvals) ;; initial values start with keyvals
(runconfig #f)
(serverdat (if (args:get-arg "-server")
*runremote*
|
|
<
<
<
<
<
|
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
*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))
(testpatt (common:args-get-testpatt #f))
(keys (keys:config-get-fields mconfig))
(keyvals (keys:target->keyval keys target))
(toppath *toppath*)
(envdat keyvals) ;; initial values start with keyvals
(runconfig #f)
(serverdat (if (args:get-arg "-server")
*runremote*
|
| ︙ | | | ︙ | |
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(begin
(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(if db (sqlite3:finalize! db))
(exit 1)))
;; Now have runconfigs data loaded, set environment vars
;; Only now can we calculate the testpatt
(set! testpatt (common:args-get-testpatt))
(for-each (lambda (section)
(for-each (lambda (varval)
(set! envdat (append envdat (list varval)))
(safe-setenv (car varval)(cadr varval)))
(configf:get-section runconfig section)))
(list "default" target))
|
|
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
(begin
(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(if db (sqlite3:finalize! db))
(exit 1)))
;; 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)
(set! envdat (append envdat (list varval)))
(safe-setenv (car varval)(cadr varval)))
(configf:get-section runconfig section)))
(list "default" target))
|
| ︙ | | | ︙ | |
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand)
(set-signal-handler! signal/stop sighand))
;; register this run in monitor.db
(rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
(rmt:tasks-set-state-given-param-key task-key "running")
(runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
|
>
>
>
>
>
>
>
|
|
<
|
|
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand)
(set-signal-handler! signal/stop sighand))
(runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
(set! runconf (if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
(begin
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf)
#f)))
;; register this run in monitor.db
(rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
(rmt:tasks-set-state-given-param-key task-key "running")
(if (not test-patts) ;; first time in - adjust testpatt
(set! test-patts (common:args-get-testpatt runconf)))
;; Now generate all the tests lists
(set! all-tests-registry (tests:get-all))
(set! all-test-names (hash-table-keys all-tests-registry))
(set! test-names (tests:filter-test-names all-test-names test-patts))
;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.
|
| ︙ | | | ︙ | |
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
)))
waitons)
(let ((remtests (delete-duplicates (append waitons tal))))
(if (not (null? remtests))
(begin
(debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
(loop (car remtests)(cdr remtests))))))))
(if (not (null? required-tests))
(debug:print-info 1 "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 "test-records=" (hash-table->alist test-records))
(let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
|
|
|
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
)))
waitons)
(let ((remtests (delete-duplicates (append waitons tal))))
(if (not (null? remtests))
(begin
;; (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
(loop (car remtests)(cdr remtests))))))))
(if (not (null? required-tests))
(debug:print-info 1 "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 "test-records=" (hash-table->alist test-records))
(let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
|
| ︙ | | | ︙ | |