︙ | | | ︙ | |
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
|
;; 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)
;; 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!?
;;
;;======================================================================
|
|
>
|
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
|
;; 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")
;; 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!?
;;
;;======================================================================
|
︙ | | | ︙ | |
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
|
(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 ))
(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.
;;
|
|
|
|
|
|
|
|
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
(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 ))
(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.
;;
|
︙ | | | ︙ | |
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
|
(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
;; 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")
|
>
>
|
|
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
|
(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")
|
︙ | | | ︙ | |
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
|
(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")))
(if (or lock
(and unlock
(begin
(print "Do you really wish to unlock run " run-id "?\n y/n: ")
(equal? "y" (read-line)))))
(rmt:lock/unlock-run run-id lock unlock user)
(debug:print-info 0 *default-log-port* "Skipping lock/unlock on " run-id))))
runs)))
;;======================================================================
;; Rollup runs
;;======================================================================
;; Update the test_meta table for this test
|
|
>
>
>
>
|
|
>
>
|
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
|
(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"))
(str (if lock
"lock"
"unlock")))
(if (or lock
(and unlock
(or (args:get-arg "-force")
(begin
(print "Do you really wish to unlock run " run-id "?\n y/n: ")
(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
|
︙ | | | ︙ | |