2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
|
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
|
((print-run)
(debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
action)
((run-wait)
(debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete"))
((archive)
(debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname"))
(set! worker-thread (make-thread (lambda ()
(case (string->symbol (args:get-arg "-archive"))
((save save-remove keep-html)(archive:run-bup (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
((restore)(archive:bup-restore (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
(else
(debug:print-error 0 *default-log-port* "unrecognised sub command to -archive. Run \"megatest\" to see help")
(exit))))
"archive-bup-thread"))
(set! worker-thread
(make-thread
(lambda ()
(case (string->symbol (args:get-arg "-archive"))
((save save-remove keep-html)
(archive:run-bup (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
((restore)
(archive:bup-restore (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
(else
(debug:print-error 0 *default-log-port* "unrecognised sub command to -archive. Run \"megatest\" to see help")
(exit))))
"archive-bup-thread"))
(thread-start! worker-thread))
(else
(debug:print-info 0 *default-log-port* "action not recognised " action)))
;; actions that operate on one test at a time can be handled below
;;
(let ((sorted-tests (filter
|