︙ | | |
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
|
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
|
-
+
+
+
|
;; Ensure all tests are registered in the test_meta table
(runs:update-all-test_meta #f)
;; run the run prehook if there are no tests yet run for this run:
;;
(runs:run-pre-hook run-id)
;; mark all test launced flag as false in the meta table
(rmt:set-var (conc "lunch-complete-" run-id) "no")
(rmt:set-run-state-status run-id "new" "n/a")
;; now add non-directly referenced dependencies (i.e. waiton)
;;======================================================================
;; refactoring this block into tests:get-full-data
;;
;; What happended, this code is now duplicated in tests!?
;;
;;======================================================================
|
︙ | | |
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
|
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
|
-
-
-
-
-
-
+
+
+
+
+
+
|
(if (not (hash-table-ref/default flags "-rerun" #f))
(hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS"))
;; recursive call to self
(runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))))
(debug:print-info 0 *default-log-port* "No tests to run")))
(debug:print-info 4 *default-log-port* "All done by here")
;; TODO: try putting post hook call here
(if (eq? run-count 0)
(begin
(debug:print-info 0 *default-log-port* "Calling Post Hook")
(debug:print-info 2 *default-log-port* " run-count " run-count)
(runs:run-post-hook run-id))
(debug:print-info 2 *default-log-port* "Not calling post hook runcount = " run-count ))
;(if (eq? run-count 0)
; (begin
; (debug:print-info 0 *default-log-port* "Calling Post Hook")
; (debug:print-info 2 *default-log-port* " run-count " run-count)
; (runs:run-post-hook run-id))
; (debug:print-info 2 *default-log-port* "Not calling post hook runcount = " run-count ))
(rmt:tasks-set-state-given-param-key task-key "done")
;; (sqlite3:finalize! tasks-db)
))
;; loop logic. These are used in runs:run-tests-queue to make it a bit more readable.
;;
|
︙ | | |
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
|
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
|
+
+
-
+
|
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-8")
(debug:print-info 0 *default-log-port* "Have leftovers!")
(loop (car reg)(cdr reg) '() reruns))
(else
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-9")
(debug:print-info 4 *default-log-port* "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
))) ;; end loop on sorted test names
;; this is the point where everything is launced and now you can mark the run in metadata table as all launced
(rmt:set-var (conc "lunch-complete-" run-id) "yes")
;; now *if* -run-wait we wait for all tests to be done
;; Now wait for any RUNNING tests to complete (if in run-wait mode)
(thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
(let wait-loop ((num-running (rmt:get-count-tests-running-for-run-id run-id))
(prev-num-running 0))
;; (debug:print-info 13 *default-log-port* "num-running=" num-running ", prev-num-running=" prev-num-running)
(if (and (or (args:get-arg "-run-wait")
|
︙ | | |
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
|
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
|
-
+
+
+
+
+
-
+
-
+
+
+
|
(define (runs:handle-locking target keys runname lock unlock user)
(let* ((db #f)
(rundat (mt:get-runs-by-patt keys runname target))
(header (vector-ref rundat 0))
(runs (vector-ref rundat 1)))
(for-each (lambda (run)
(let ((run-id (db:get-value-by-header run header "id")))
(let ((run-id (db:get-value-by-header run header "id"))
(str (if lock
"lock"
"unlock")))
(if (or lock
(and unlock
(or (args:get-arg "-force")
(begin
(begin
(print "Do you really wish to unlock run " run-id "?\n y/n: ")
(equal? "y" (read-line)))))
(equal? "y" (read-line))))))
(begin
(rmt:lock/unlock-run run-id lock unlock user)
(debug:print-info 0 *default-log-port* "Done " str " on run id " run-id))
(debug:print-info 0 *default-log-port* "Skipping lock/unlock on " run-id))))
runs)))
;;======================================================================
;; Rollup runs
;;======================================================================
;; Update the test_meta table for this test
|
︙ | | |