1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
|
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
|
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
;; incompleted))
(min-incompleted-ids (map car incompleted)) ;; do 'em all
(all-ids (append min-incompleted-ids (map car oldlaunched))))
(if (> (length all-ids) 0)
(begin
(debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
(for-each
(lambda (test-id)
(db:test-set-status-state dbstruct run-id test-id "COMPLETE" "DEAD" "Test failed to complete"))
all-ids))))))
;; ALL REPLACED BY THE BLOCK ABOVE
;;
(sqlite3:execute
db
(conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN ("
(string-intersperse (map conc all-ids) ",")
");")
run-id))))
;; Now do rollups for the toplevel tests
;;
;; (db:delay-if-busy dbdat)
(for-each
(lambda (toptest)
(let ((test-name (list-ref toptest 3)))
;; (run-id (list-ref toptest 5)))
(db:top-test-set-per-pf-counts dbstruct run-id test-name)))
toplevels)))
;; (sqlite3:execute
;; db
;; (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN ("
;; (string-intersperse (map conc all-ids) ",")
;; ");")
;; run-id))))
;;
;; ;; Now do rollups for the toplevel tests
;; ;;
;; ;; (db:delay-if-busy dbdat)
;; (for-each
;; (lambda (toptest)
;; (let ((test-name (list-ref toptest 3)))
;; ;; (run-id (list-ref toptest 5)))
;; (db:top-test-set-per-pf-counts dbstruct run-id test-name)))
;; toplevels)))
;; BUG: Probably broken - does not explicitly use run-id in the query
;;
(define (db:top-test-set-per-pf-counts dbstruct run-id test-name)
(db:general-call (db:get-db dbstruct run-id) 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name)))
|