5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
|
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
|
-
+
|
;;======================================================================
;;
;; test-names: Comma separated patterns same as test-patts but used in selection
;; of tests to run. The item portions are not respected.
;; FIXME: error out if /patt specified
;;
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
(let* ((keys (keys:config-get-fields *configdat*))
(let* ((keys (common:get-fields *configdat*))
(keyvals (keys:target->keyval keys target))
(run-id (rmt:register-run keyvals runname "new" "n/a" user (args:get-arg "-contour"))) ;; test-name)))
;; (deferred '()) ;; delay running these since they have a waiton clause
(runconfigf (conc *toppath* "/runconfigs.config"))
(dbfile (conc *toppath* "/megatest.db"))
(readonly-mode (not (file-write-access? dbfile)))
(test-records (make-hash-table))
|
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
|
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
|
-
+
|
;; (launch:cache-config) ;; there are two independent config cache locations, turning this one off for now. MRW.
) ;; do not cache here - need to be sure runconfigs is processed
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
(set! keys (keys:config-get-fields *configdat*))
(set! keys (common:get-fields *configdat*))
;; 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 #t 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)
|
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
|
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
|
-
+
|
(debug:print-info 13 log-port "Done db:open-db")
;; (set! *dbstruct-db* dbstruct)
alldat))))
;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?
;; using common:get-fields?
(define (db:get-keys alldat)
(if (alldat-db-keys alldat)
(alldat-db-keys alldat)
(let ((res '()))
(db:with-db alldat #f #f
(lambda (db)
|