197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
;; 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*))
(keyvals (keys:target->keyval keys target))
(run-id (rmt:register-run keyvals runname "new" "n/a" user)) ;; test-name)))
;; (deferred '()) ;; delay running these since they have a waiton clause
(runconfigf (conc *toppath* "/runconfigs.config"))
(test-records (make-hash-table))
;; need to process runconfigs before generating these lists
(all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
(all-test-names #f) ;; (hash-table-keys all-tests-registry))
(test-names #f) ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
|
|
|
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
;; 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*))
(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"))
(test-records (make-hash-table))
;; need to process runconfigs before generating these lists
(all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
(all-test-names #f) ;; (hash-table-keys all-tests-registry))
(test-names #f) ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
|
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
|
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 *default-log-port* "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (rmt:find-and-mark-incomplete)
(let* ((run-info (rmt:get-run-info run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries"))
(max-concurrent-jobs (let ((mcj (config-lookup *configdat* "setup" "max_concurrent_jobs")))
|
|
|
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
|
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 *default-log-port* "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (rmt:find-and-mark-incomplete)
(let* ((run-info (rmt:get-run-info run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries"))
(max-concurrent-jobs (let ((mcj (config-lookup *configdat* "setup" "max_concurrent_jobs")))
|
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
|
;; This could probably be refactored into one complex query ...
;; NOT PORTED - DO NOT USE YET
;;
(define (runs:rollup-run keys runname user keyvals)
(debug:print 4 *default-log-port* "runs:rollup-run, keys: " keys " -runname " runname " user: " user)
(let* ((db #f)
;; register run operates on the main db
(new-run-id (rmt:register-run keyvals runname "new" "n/a" user))
(prev-tests (rmt:get-matching-previous-test-run-records new-run-id "%" "%"))
(curr-tests (mt:get-tests-for-run new-run-id "%/%" '() '()))
(curr-tests-hash (make-hash-table)))
(rmt:update-run-event_time new-run-id)
;; index the already saved tests by testname and itemdat in curr-tests-hash
(for-each
(lambda (testdat)
|
|
|
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
|
;; This could probably be refactored into one complex query ...
;; NOT PORTED - DO NOT USE YET
;;
(define (runs:rollup-run keys runname user keyvals)
(debug:print 4 *default-log-port* "runs:rollup-run, keys: " keys " -runname " runname " user: " user)
(let* ((db #f)
;; register run operates on the main db
(new-run-id (rmt:register-run keyvals runname "new" "n/a" user (args:get-arg "-contour")))
(prev-tests (rmt:get-matching-previous-test-run-records new-run-id "%" "%"))
(curr-tests (mt:get-tests-for-run new-run-id "%/%" '() '()))
(curr-tests-hash (make-hash-table)))
(rmt:update-run-event_time new-run-id)
;; index the already saved tests by testname and itemdat in curr-tests-hash
(for-each
(lambda (testdat)
|