Megatest

Diff
Login

Differences From Artifact [e64acf4e6f]:

To Artifact [97c60d5363]:


724
725
726
727
728
729
730
731

732
733
734
735
736
737
738
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)
  ;; (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
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)))
      ;; (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")))