290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
(begin
(debug:print 0 *default-log-port* "WARNING: You do not have a run config file: " runconfigf)
#f)))
(if (not test-patts) ;; first time in - adjust testpatt
(set! test-patts (common:args-get-testpatt runconf)))
(if (args:get-arg "-tagexpr")
(begin
(set! allowed-tests (string-join (runs:get-tests-matching-tags (args:get-arg "-tagexpr")) ","))
(debug:print-info 0 *default-log-port* "filtering initial test list with tagexpr: " (args:get-arg "-tagexpr") " => " allowed-tests)
));; tests will be ANDed with this list
;; register this run in monitor.db
|
>
>
>
>
>
>
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
|
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
(begin
(debug:print 0 *default-log-port* "WARNING: You do not have a run config file: " runconfigf)
#f)))
(if (not test-patts) ;; first time in - adjust testpatt
(set! test-patts (common:args-get-testpatt runconf)))
;; if test-patts is #f at this point there is something wrong and we need to bail out
(if (not test-patts)
(begin
(debug:print 0 *default-log-port* "WARNING: there is no test pattern for this run. Exiting now.")
(exit 0)))
(if (args:get-arg "-tagexpr")
(begin
(set! allowed-tests (string-join (runs:get-tests-matching-tags (args:get-arg "-tagexpr")) ","))
(debug:print-info 0 *default-log-port* "filtering initial test list with tagexpr: " (args:get-arg "-tagexpr") " => " allowed-tests)
));; tests will be ANDed with this list
;; register this run in monitor.db
|
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
|
(let* ((write-access-actions '(remove-runs set-state-status archive run-wait))
(dbfile (conc *toppath* "/megatest.db"))
(readonly-mode (not (file-write-access? dbfile))))
(when (and readonly-mode
(member action write-access-actions))
(debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .")
(exit 1)))
(debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)
(if (> 2 (length state-status))
(begin
(debug:print-error 0 *default-log-port* "the parameter to -set-state-status is a comma delimited string. E.g. COMPLETED,FAIL")
(exit)))
(for-each
|
<
|
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
|
(let* ((write-access-actions '(remove-runs set-state-status archive run-wait))
(dbfile (conc *toppath* "/megatest.db"))
(readonly-mode (not (file-write-access? dbfile))))
(when (and readonly-mode
(member action write-access-actions))
(debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .")
(exit 1)))
(debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)
(if (> 2 (length state-status))
(begin
(debug:print-error 0 *default-log-port* "the parameter to -set-state-status is a comma delimited string. E.g. COMPLETED,FAIL")
(exit)))
(for-each
|