Megatest

Diff
Login

Differences From Artifact [f13f11d288]:

To Artifact [54a3cda2af]:


479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
				       (mutex-lock! registry-mutex)
				       (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'done)
				       (mutex-unlock! registry-mutex))
				     (conc test-name "/" item-path))))
		(thread-start! th))
	      (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
	      (if (and (null? tal)(null? reg))
		  (loop hed tal (append reg (list head)) reruns)
		  (loop (runs:queue-next-hed tal reg reglen regfull)
			(runs:queue-next-tal tal reg reglen regfull)
			;; NB// Here we are building reg as we register tests
			;; if regfull we must pop the front item off reg
			(if regfull
			    (append (cdr reg) (list hed))
			    (append reg (list hed)))







|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
				       (mutex-lock! registry-mutex)
				       (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'done)
				       (mutex-unlock! registry-mutex))
				     (conc test-name "/" item-path))))
		(thread-start! th))
	      (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
	      (if (and (null? tal)(null? reg))
		  (loop hed tal (append reg (list hed)) reruns)
		  (loop (runs:queue-next-hed tal reg reglen regfull)
			(runs:queue-next-tal tal reg reglen regfull)
			;; NB// Here we are building reg as we register tests
			;; if regfull we must pop the front item off reg
			(if regfull
			    (append (cdr reg) (list hed))
			    (append reg (list hed)))
588
589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
		     (tests:testqueue-set-item_path! new-test-record my-item-path)
		     (hash-table-set! test-records newtestname new-test-record)
		     (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
	   items)
	  ;; At this point we have possibly added items to tal but all must be handed off to 
	  ;; INNER COND logic. I think loop without rotating the queue 
	  ;; (loop hed tal reg reruns))
	  (let ((newtal (append tal (list hed))))
	    (loop (car newtal)(cdr newtal) reg reruns)))

	    
	 ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
	 ;;    - but only do that if resources exist to kick off the job
	 ((or (procedure? items)(eq? items 'have-procedure))
	  (debug:print-info 4 "INNER COND: (or (procedure? items)(eq? items 'have-procedure))")
	  (let ((can-run-more    (runs:can-run-more-tests jobgroup max-concurrent-jobs)))
	    (if (and (list? can-run-more)







|
|
>







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
		     (tests:testqueue-set-item_path! new-test-record my-item-path)
		     (hash-table-set! test-records newtestname new-test-record)
		     (set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
	   items)
	  ;; At this point we have possibly added items to tal but all must be handed off to 
	  ;; INNER COND logic. I think loop without rotating the queue 
	  ;; (loop hed tal reg reruns))
	  ;; (let ((newtal (append tal (list hed))))  ;; We should discard hed as it has been expanded into it's items?
	  ;;   (loop (car newtal)(cdr newtal) reg reruns)) ;; )
	  (loop (car tal)(cdr tal) reg reruns))
	    
	 ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
	 ;;    - but only do that if resources exist to kick off the job
	 ((or (procedure? items)(eq? items 'have-procedure))
	  (debug:print-info 4 "INNER COND: (or (procedure? items)(eq? items 'have-procedure))")
	  (let ((can-run-more    (runs:can-run-more-tests jobgroup max-concurrent-jobs)))
	    (if (and (list? can-run-more)
644
645
646
647
648
649
650


651
652
653
654
655
656
657
658
659
660
661
662
		    (if (eq? 0 (list-ref can-run-more 1))
			(begin
			  ;; TRY (if (> num-retries 100) ;; first 100 retries are low time cost
			  ;; TRY     (thread-sleep! (+ 2 *global-delta*))
			  ;; TRY     (thread-sleep! (+ 0.01 *global-delta*)))
			  (set! num-retries (+ num-retries 1))))
		    (if (> num-retries  max-retries)


			(if (not (null? tal))
			    (loop (runs:queue-next-hed tal reg reglen regfull)
				  (runs:queue-next-tal tal reg reglen regfull)
				  (runs:queue-next-reg tal reg reglen regfull)
				  reruns))
			(loop (car newtal)(cdr newtal) reg reruns))) ;; an issue with prereqs not yet met?
		   ((and (not (null? fails))(eq? testmode 'normal))
		    (debug:print-info 1 "test "  hed " (mode=" testmode ") has failed prerequisite(s); "
				      (string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
				      ", removing it from to-do list")
		    (if (or (not (null? reg))(not (null? tal)))
			(begin







>
>
|
|
|
|
|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
		    (if (eq? 0 (list-ref can-run-more 1))
			(begin
			  ;; TRY (if (> num-retries 100) ;; first 100 retries are low time cost
			  ;; TRY     (thread-sleep! (+ 2 *global-delta*))
			  ;; TRY     (thread-sleep! (+ 0.01 *global-delta*)))
			  (set! num-retries (+ num-retries 1))))
		    (if (> num-retries  max-retries)
			(begin
			  (debug:print 0 "WARNING: retries exceed " max-retries ", this may not be handled correctly. Please consider reporting this scenario.")
			  (if (not (null? tal))
			      (loop (runs:queue-next-hed tal reg reglen regfull)
				    (runs:queue-next-tal tal reg reglen regfull)
				    (runs:queue-next-reg tal reg reglen regfull)
				    reruns)))
			(loop (car newtal)(cdr newtal) reg reruns))) ;; an issue with prereqs not yet met?
		   ((and (not (null? fails))(eq? testmode 'normal))
		    (debug:print-info 1 "test "  hed " (mode=" testmode ") has failed prerequisite(s); "
				      (string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
				      ", removing it from to-do list")
		    (if (or (not (null? reg))(not (null? tal)))
			(begin