213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
+
-
+
|
;;
(define (runs:run-tests target runname test-names test-patts user flags)
(common:clear-caches) ;; clear all caches
(let* ((db #f)
(keys (cdb:remote-run db:get-keys #f))
(keyvallst (keys:target->keyval keys target))
(run-id (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user)) ;; test-name)))
(keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f))
(deferred '()) ;; delay running these since they have a waiton clause
;; keepgoing is the defacto modality now, will add hit-n-run a bit later
;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f))
(runconfigf (conc *toppath* "/runconfigs.config"))
(required-tests '())
(test-records (make-hash-table)))
(set-megatest-env-vars run-id) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(open-run-close setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "pre-launch-env-vars")
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars")
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
;; look up all tests matching the comma separated list of globs in
;; test-patts (using % as wildcard)
(set! test-names (tests:get-valid-tests *toppath* test-names))
(set! test-names (delete-duplicates test-names))
|
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
|
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
|
-
-
-
-
-
+
+
+
+
+
|
(let ((db #f)
(keys #f))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(if (args:get-arg "-server")
(open-run-close server:start db (args:get-arg "-server"))
(if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers
(args:get-arg "-runtests")))
(server:client-setup) ;; This is a duplicate startup!!!??? BUG?
))
(open-run-close server:start db (args:get-arg "-server")))
;; (if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers
;; (args:get-arg "-runtests")))
;; (server:client-setup) ;; This is a duplicate startup!!!??? BUG?
;; ))
(set! keys (open-run-close db:get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #f environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|