549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
-
+
|
(run-id (register-run db keys)) ;; test-name)))
(deferred '()) ;; delay running these since they have a waiton clause
(runconfigf (conc *toppath* "/runconfigs.config")))
;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
;; -keepgoing is specified
(if (file-exists? runconfigf)
(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* environ-patt: ".*")
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
(if (and (eq? *passnum* 0)
(args:get-arg "-keepgoing"))
(begin
;; have to delete test records where NOT_STARTED since they can cause -keepgoing to
;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends
|
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
|
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
|
-
+
|
(deferred '()) ;; delay running these since they have a waiton clause
(keepgoing (hash-table-ref/default flags "-keepgoing" #f))
(test-names '())
(runconfigf (conc *toppath* "/runconfigs.config"))
(required-tests '()))
(if (file-exists? runconfigf)
(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "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)
(for-each
(lambda (patt)
(let ((tests (glob (conc *toppath* "/tests/" (string-translate patt "%" "*")))))
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
|
-
-
+
+
|
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(set! keys (db-get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; evaluate all
(runconfig (read-config runconfigf #f #f environ-patt: ".*")))
(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)
(begin
(debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(sqlite3:finalize! db)
(exit 1))))
(if (args:get-arg "-target")
|