Megatest

Diff
Login

Differences From Artifact [33b2be809c]:

To Artifact [6923ee1d25]:


406
407
408
409
410
411
412

413
414


415
416
417
418
419
420
421
422

423
424
425
426
427
428
429
406
407
408
409
410
411
412
413


414
415
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430







+
-
-
+
+







-
+







		 ((not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path)) ;; This test/itempath is not to be run
		  ;; else the run is stuck, temporarily or permanently
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  (debug:print-info 1 "Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " test-patts)
		  (thread-sleep! *global-delta*)
		  (if (not (null? tal))
		      (loop (car tal)(cdr tal) reruns)))
		 ( ;; (and
		 ((and (not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		       (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5)))
		  (not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		      ;; (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5)))
		  (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
		  (open-run-close db:tests-register-test #f run-id test-name item-path)
		  (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t)
		  (thread-sleep! *global-delta*)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not have-resources) ;; simply try again after waiting a second
		  (debug:print-info 1 "no resources to run new tests, waiting ...")
		  (thread-sleep! (+ 0.01 *global-delta*))
		  (thread-sleep! (+ 2 *global-delta*))
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
		  (loop (car newtal)(cdr newtal) reruns))
		 ((and have-resources
		       (or (null? prereqs-not-met)
			   (and (eq? testmode 'toplevel)
				(null? non-completed))))
		  (run:test run-id runname keyvallst test-record flags #f)
480
481
482
483
484
485
486

487

488
489
490
491
492
493
494
481
482
483
484
485
486
487
488

489
490
491
492
493
494
495
496







+
-
+







		    (thread-sleep! (+ 0.01 *global-delta*))
		    (loop (car tal)(cdr tal) 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))
	      (let ((can-run-more    (runs:can-run-more-tests test-record)))
		(if (and (list? can-run-more)
		(if can-run-more
			 (car can-run-more))
		    (let* ((prereqs-not-met (open-run-close db:get-prereqs-not-met #f run-id waitons item-path mode: testmode))
			   (fails           (runs:calc-fails prereqs-not-met))
			   (non-completed   (runs:calc-not-completed prereqs-not-met)))
		      (debug:print-info 8 "can-run-more: " can-run-more
				   "\n testname:        " hed
				   "\n prereqs-not-met: " (runs:pretty-string prereqs-not-met)
				   "\n non-completed:   " (runs:pretty-string non-completed) 
544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
546
547
548
549
550
551
552

553
554
555
556
557
558
559
560







-
+







			(debug:print 8 "ERROR: No handler for this condition.")
			(thread-sleep! (+ 1 *global-delta*))
			(loop (car newtal)(cdr newtal) reruns)))) ;; END OF IF CAN RUN MORE

		    ;; if can't run more just loop with next possible test
		    (begin
		      (debug:print-info 4 "processing the case with a lambda for items or 'have-procedure. Moving through the queue without dropping " hed)
		      (thread-sleep! (+ 1 *global-delta*))
		      (thread-sleep! (+ 2 *global-delta*))
		      (loop (car newtal)(cdr newtal) reruns))))) ;; END OF (or (procedure? items)(eq? items 'have-procedure))
	     
	     ;; this case should not happen, added to help catch any bugs
	     ((and (list? items) itemdat)
	      (debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
	      (exit 1))
	     ((not (null? reruns))