360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
|
((not (patt-list-match item-path item-patts))
;; else the run is stuck, temporarily or permanently
;; but should check if it is due to lack of resources vs. prerequisites
(debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts)
(if (not (null? tal))
(loop (car tal)(cdr tal))))
((not (hash-table-ref/default test-registery (conc test-name "/" item-path) #f))
(open-run-close tests:register-test #f run-id test-name item-path)
(hash-table-set! test-registery (conc test-name "/" item-path) #t)
(loop (car newtal)(cdr newtal)))
((not have-resources) ;; simply try again after waiting a second
(thread-sleep! (+ 1 *global-delta*))
(debug:print 1 "INFO: no resources to run new tests, waiting ...")
;; could have done hed tal here but doing car/cdr of newtal to rotate tests
(loop (car newtal)(cdr newtal)))
|
|
|
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
|
((not (patt-list-match item-path item-patts))
;; else the run is stuck, temporarily or permanently
;; but should check if it is due to lack of resources vs. prerequisites
(debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts)
(if (not (null? tal))
(loop (car tal)(cdr tal))))
((not (hash-table-ref/default test-registery (conc test-name "/" item-path) #f))
(open-run-close db:tests-register-test #f run-id test-name item-path)
(hash-table-set! test-registery (conc test-name "/" item-path) #t)
(loop (car newtal)(cdr newtal)))
((not have-resources) ;; simply try again after waiting a second
(thread-sleep! (+ 1 *global-delta*))
(debug:print 1 "INFO: no resources to run new tests, waiting ...")
;; could have done hed tal here but doing car/cdr of newtal to rotate tests
(loop (car newtal)(cdr newtal)))
|
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
;; (system (conc "mkdir -p " new-test-path))
;;
;; (open-run-close tests:register-test db run-id test-name item-path)
;;
;; NB// for the above line. I want the test to be registered long before this routine gets called!
;;
(set! test-id (open-run-close db:get-test-id db run-id test-name item-path))
(debug:print 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=" item-path)
(set! testdat (open-run-close db:get-test-info-by-id db test-id))))
(set! test-id (db:test-get-id testdat))
(change-directory test-path)
(case (if force ;; (args:get-arg "-force")
'NOT_STARTED
(if testdat
(string->symbol (test:get-state testdat))
|
>
>
>
>
>
|
|
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
;; (system (conc "mkdir -p " new-test-path))
;;
;; (open-run-close tests:register-test db run-id test-name item-path)
;;
;; NB// for the above line. I want the test to be registered long before this routine gets called!
;;
(set! test-id (open-run-close db:get-test-id db run-id test-name item-path))
(if (not test-id)
(begin
(debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
(open-run-close db:tests-register-test db run-id test-name item-path)
(set! test-id (open-run-close db:get-test-id db run-id test-name item-path))))
(debug:print 4 "INFO: test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
(set! testdat (open-run-close db:get-test-info-by-id db test-id))))
(set! test-id (db:test-get-id testdat))
(change-directory test-path)
(case (if force ;; (args:get-arg "-force")
'NOT_STARTED
(if testdat
(string->symbol (test:get-state testdat))
|