724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
| (define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)
;; At this point the list of parent tests is expanded
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
(cdb:remote-run db:find-and-mark-incomplete #f)
(let ((run-info (cdb:remote-run db:get-run-info #f run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
|
|
| 724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
| (define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)
;; At this point the list of parent tests is expanded
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (cdb:remote-run db:find-and-mark-incomplete #f)
(let ((run-info (cdb:remote-run db:get-run-info #f run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
|
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
| (let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names))
(reg '()) ;; registered, put these at the head of tal
(reruns '()))
(if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))
;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes
(if (> (current-seconds)(+ last-time-incomplete 900))
(begin
(set! last-time-incomplete (current-seconds))
(cdb:remote-run db:find-and-mark-incomplete #f)))
;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
(tconfig (tests:testqueue-get-testconfig test-record))
(jobgroup (config-lookup tconfig "requirements" "jobgroup"))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
|
|
|
|
|
| 759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
| (let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names))
(reg '()) ;; registered, put these at the head of tal
(reruns '()))
(if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))
;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes
;; (if (> (current-seconds)(+ last-time-incomplete 900))
;; (begin
;; (set! last-time-incomplete (current-seconds))
;; (cdb:remote-run db:find-and-mark-incomplete #f)))
;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
(tconfig (tests:testqueue-get-testconfig test-record))
(jobgroup (config-lookup tconfig "requirements" "jobgroup"))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
|