521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
;; we get here on "drop through" - loop for next test in queue
(if (null? tal)
(begin
;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
(debug:print 1 "INFO: All tests launched")
(thread-sleep! 0.5)
;; FIXME! This harsh exit should not be necessary....
(if (not *runremote*)(exit)) ;;
#f) ;; return a #f as a hint that we are done
;; Here we need to check that all the tests remaining to be run are eligible to run
;; and are not blocked by failed
(let* ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print 4 "INFO: full drop through, if reruns is less than 100 we will force retry them: " reruns)
(if (< num-retries max-retries)
|
|
|
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
;; we get here on "drop through" - loop for next test in queue
(if (null? tal)
(begin
;; FIXME!!!! THIS SHOULD NOT REQUIRE AN EXIT!!!!!!!
(debug:print 1 "INFO: All tests launched")
(thread-sleep! 0.5)
;; FIXME! This harsh exit should not be necessary....
;; (if (not *runremote*)(exit)) ;;
#f) ;; return a #f as a hint that we are done
;; Here we need to check that all the tests remaining to be run are eligible to run
;; and are not blocked by failed
(let* ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print 4 "INFO: full drop through, if reruns is less than 100 we will force retry them: " reruns)
(if (< num-retries max-retries)
|
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
|
(else
(let ((db #f)
(keys #f))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(server:start db (args:get-arg "-server"))
(if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers
(args:get-arg "-runtests")))
(server:client-setup db)
(begin
(sqlite3:finalize! db)
(set! db #f))))
(set! keys (open-run-close db:get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #f environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|
<
|
|
<
<
<
|
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
|
(else
(let ((db #f)
(keys #f))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(if (args:get-arg "-server")
(open-run-close server:start db (args:get-arg "-server"))
(if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers
(args:get-arg "-runtests")))
(server:client-setup)))
(set! keys (open-run-close db:get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #f environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|