462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
|
(required-tests #f) ;; Put fully qualified test/testpath names in this list to be done
(waitors-upon (make-hash-table)) ;; given a test, return list of tests waiting upon this test.
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
;; (tdbdat (tasks:open-db))
(config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns")))
(if x (string->number x) #f)))
(allowed-tests #f)
(runconf #f))
;; check if readonly
(when readonly-mode
(debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed.")
(exit 1))
;; per user request. If less than 100Meg space on dbdir partition, bail out with error
|
|
>
>
|
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
|
(required-tests #f) ;; Put fully qualified test/testpath names in this list to be done
(waitors-upon (make-hash-table)) ;; given a test, return list of tests waiting upon this test.
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
;; (tdbdat (tasks:open-db))
(config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns")))
(if x (string->number x) #f)))
(allowed-tests #f)
(runconf #f)
(cache-files (launch:get-cache-file-paths #f (common:get-toppath *toppath* ) target))
(runstart-time (current-seconds)))
;; check if readonly
(when readonly-mode
(debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed.")
(exit 1))
;; per user request. If less than 100Meg space on dbdir partition, bail out with error
|
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
|
(thread-start! th2)
;; (thread-join! th1)
;; just do the main stuff in the main thread
(runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests
(any->number reglen) all-tests-registry)
(set! keep-going #f)
(thread-join! th2)
;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD
(if (> run-count 0) ;; handle reruns
(begin
(if (not (hash-table-ref/default flags "-preclean" #f))
(hash-table-set! flags "-preclean" #t))
(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)))
(launch:end-of-run-check run-id)))
|
>
>
>
>
>
|
|
|
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
|
(thread-start! th2)
;; (thread-join! th1)
;; just do the main stuff in the main thread
(runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests
(any->number reglen) all-tests-registry)
(set! keep-going #f)
(thread-join! th2)
(if (launch:cache-files-changed? cache-files runstart-time)
(begin ;; force a start-over
(launch:setup force-reread: #t)
(runs:run-tests target runname test-patts user flags run-count: 0)))
;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD
(if (> run-count 0) ;; handle reruns
(begin
(if (not (hash-table-ref/default flags "-preclean" #f))
(hash-table-set! flags "-preclean" #t))
(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)))
(launch:end-of-run-check run-id)))
(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
; (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 ))
|