926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
-
+
|
(else
(if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60)
(debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now."))
;; (debug:print 0 *default-log-port* " prereqs: " prereqs-not-met)
(hash-table-set! test-registry hed 'removed)
(mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f)
;; I'm unclear on if this roll up is needed - it may be the root cause of the "all set to FAIL" bug.
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "FAIL" #f) ;; treat as FAIL
(rmt:set-state-status-and-roll-up-items run-id test-name item-path #f "FAIL" #f) ;; treat as FAIL
(list (if (null? tal)(car newtal)(car tal))
tal
reg
reruns)))))
;; can't drop this - maybe running? Just keep trying
(let ((runable-tests (runs:runable-tests prereqs-not-met)))
(if (null? runable-tests)
|
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
|
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
|
+
|
(begin
(case action
((remove-runs)
;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
;; seek and kill in flight -runtests with % as testpatt here
;; (if (equal? testpatt "%")
(tasks:kill-runner target run-name testpatt)
;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
(if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
(debug:print 1 *default-log-port* "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((print-run)
(debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
|
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
|
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
|
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(val (config-lookup test-conf "test_meta" fld)))
;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val)
(if (and val (not (equal? (vector-ref currrecord idx) val)))
(begin
(print "Updating " test-name " " fld " to " val)
(rmt:testmeta-update-field test-name fld val)))))
'(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10)))))
;; find tests with matching tags, tagpatt is a string "tagpatt1,tagpatt2%, ..."
;;
(define (runs:get-tests-matching-tags tagpatt)
(let* ((tagdata (rmt:get-tests-tags))
(res '())) ;; list of tests that match one or more tags
(for-each
(lambda (tag)
(if (patt-list-match tag tagpatt)
(set! res (append (hash-table-ref tagdata tag)))))
(hash-table-keys tagdata))
res))
;; Update test_meta for all tests
(define (runs:update-all-test_meta db)
(let ((test-names (tests:get-all))) ;; (tests:get-valid-tests)))
(for-each
(lambda (test-name)
(let* ((test-conf (mt:lazy-read-test-config test-name)))
|