Megatest

Diff
Login

Differences From Artifact [6846f73920]:

To Artifact [3e262d9c09]:


202
203
204
205
206
207
208
209

210
211
212
213
214
215
216
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216







-
+







				    (if (string? jobg-count)
					(string->number jobg-count)
					jobg-count))))
    (if (> (+ num-running num-running-in-jobgroup) 0)
	(runs:inc-can-run-more-tests-count runsdat)) ;; (set! *runs:can-run-more-tests-count* (+ *runs:can-run-more-tests-count* 1)))
    (if (not (eq? *last-num-running-tests* num-running))
	(begin
	  (debug:print 2 *default-log-port* "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
	  (debug:print 1 *default-log-port* "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
	  (set! *last-num-running-tests* num-running)))
    (if (not (eq? 0 *globalexitstatus*))
	(list #f num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit)
	(let ((can-not-run-more (cond
				 ;; if max-concurrent-jobs is set and the number running is greater 
				 ;; than it then cannot run more jobs
				 ((and max-concurrent-jobs (>= num-running max-concurrent-jobs))
711
712
713
714
715
716
717

718
719
720
721
722
723
724
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725







+







                      (or (procedure? items)(eq? items 'have-procedure))))
                  waitons))
         (completed-prereq-items 
          (let ((foo (begin (BB> "hello prereqs: "prereqs) #t))
                (res (filter (lambda (test)
                               (BB> "foo - "test)
                               (and (vector? test)
                                    (equal? "COMPLETED" (db:test-get-state test))
                                    (equal? "COMPLETED" (db:test-get-state test))
                                    (not (equal? "" (db:test-get-item-path test)))))
                             prereqs)))
            res)) 

         )
    (debug:print-info 4 *default-log-port* "START OF INNER COND #2 "
765
766
767
768
769
770
771
772

773
774
775

776

777
778
779


780
781
782
783
784
785
786
766
767
768
769
770
771
772

773
774
775

776
777
778
779


780
781
782
783
784
785
786
787
788







-
+


-
+

+

-
-
+
+







                         (debug:print 0 *default-log-port* "WARNING: this condition is triggered when there were no items to expand and nothing to run. Please check your run for completeness")
                         (exit 0))
                       (set! runs:nothing-left-in-queue-count (+ runs:nothing-left-in-queue-count 1)))
                   #f)))

            ;;; desired result of below cond branch:
            ;;   we want to expand items in our test of interest (hed) in the following cases:
            ;;    case 1 - mode is itemmatch or itemwait: (TODO)
            ;;    case 1 - mode is itemmatch or itemwait: (DONE)
            ;;       - all prereq tests have been expanded
            ;;       - at least one prereq's items have completed
            ;;    case 2 - mode is toplevel   (DONE)
            ;;    case 2 - mode is toplevel   (PARTIAL)
            ;;       - prereqs are completed.
            ;;       - or no prereqs can complete (TODO)
            ;;    case 3 - mode not specified (DONE)
            ;;       - prereqs are completed and passed (we could consider removing "and passed" -- it would change behavior from current)
            
            ;;       - prereqs are completed and passed (we could consider removing "and passed" -- it would change behavior from current)          
                   
            ;; runs:expand-items case: toplevel or else no dangling prerequeistes -- expand items now.
            ((or
              (and have-itemized (null? unexpanded-prereqs) (not (null? completed-prereq-items)))
              (null? prereqs)            ;; nothing is in our way to proceed (need to expand this to an item level check.)
              (and (member 'toplevel testmode)   ;; for toplevel test - proceed (nothing in our way)
                   (null? non-completed)))
             (BB> "cb2")
1423
1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437
1438
1439







-
+







		  (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 tal)(cdr tal) reg reruns))))

	(runs:incremental-print-results run-id)
	(debug:print 4 *default-log-port* "TOP OF LOOP => "
	(debug:print 1 *default-log-port* "TOP OF LOOP => "
		     "test-name: " test-name
		     "\n  test-record  " test-record
		     "\n  hed:         " hed
		     "\n  itemdat:     " itemdat
		     "\n  items:       " items
		     "\n  item-path:   " item-path
		     "\n  waitons:     " waitons
1464
1465
1466
1467
1468
1469
1470







1471
1472
1473
1474
1475
1476
1477
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486







+
+
+
+
+
+
+







					    (not (member waiton reruns)))
				       1
				       #f))
				 waitons))))) ;; could do this more elegantly with a marker....
	  (debug:print 0 *default-log-port* "WARNING: Marking test " tfullname " as not runnable. It is waiting on tests that cannot be run. Giving up now.")
	  (hash-table-set! test-registry tfullname 'removed))


         ; BB - a possibility for preqfail propagation
         ;; ((and (not items) (string? item-path) (not (equal? item-path ""))
         ;;       (lset-intersection testmode '(itemmatch itemwait)))

         ;;  )

	 ;; items is #f then the test is ok to be handed off to launch (but not before)
	 ;; 
	 ((not items)
	  (debug:print-info 4 *default-log-port* "OUTER COND: (not items)")
	  (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests))
		   (not (null? tal)))
	      (loop (car tal)(cdr tal) reg reruns))
1587
1588
1589
1590
1591
1592
1593
1594

1595

1596
1597
1598
1599






1600
1601
1602
1603
1604
1605
1606

1607
1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632

1633
1634
1635
1636
1637
1638
1639
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605




1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617

1618
1619
1620
1621
1622
1623
1624
1625

1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643

1644
1645
1646
1647
1648
1649
1650
1651







-
+

+
-
-
-
-
+
+
+
+
+
+






-
+







-
+

















-
+







	    ;; (wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
	    (wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
    ;; LET* ((test-record
    ;; we get here on "drop through". All done!
    (runs:run-post-hook run-id)
    (debug:print-info 1 *default-log-port* "All tests launched")))

(define (runs:calc-fails prereqs-not-met)
(define (runs:calc-fails prereqs-not-met) ;; BB is this redundant with runs:runable-tests ?
  (filter (lambda (test)
            (or
	    (and (vector? test) ;; not (string? test))
		 (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED"))
		 (not (member (db:test-get-status test)
			      '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))))
             (and (vector? test) ;; not (string? test))
                  (member (db:test-get-status test) '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" "KILLED")))
             (and (vector? test) ;; not (string? test))
                  (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED"))
                  (not (member (db:test-get-status test)
                               '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))))))
	  prereqs-not-met))

(define (runs:calc-prereq-fail prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "NOT_STARTED")
		 (not (member (db:test-get-status test)
                 (not (member (db:test-get-status test)
			      '("n/a" "KEEP_TRYING")))))
	  prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met) ;; filter out tests which have reached a ground state -- they are done one way or another.
  (filter 
   (lambda (t)
     (or (not (vector? t))
         (not (and (equal? (db:test-get-state t) "NOT_STARTED") (equal? (db:test-get-status t) "PREQ_FAIL")))
         (not (member (db:test-get-status t) '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" "KILLED")))
	 (not (member (db:test-get-state t) '("INCOMPLETE" "COMPLETED")))))
   prereqs-not-met))

;; (define (runs:calc-not-completed prereqs-not-met)
;;   (filter
;;    (lambda (t)
;;      (or (not (vector? t))
;; 	 (not (equal? "COMPLETED" (db:test-get-state t)))))
;;    prereqs-not-met))

(define (runs:calc-runnable prereqs-not-met)
  (filter 
   (lambda (t)
     (or (not (vector? t))
	 (and (equal? "NOT_STARTED" (db:test-get-state t))
	      (member (db:test-get-status t)
		      '("n/a" "KEEP_TRYING")))
	 (and (equal? "RUNNING" (db:test-get-state t))))) ;; account for a test that is running
	 (and (member (db:test-get-state t) '("RUNNING" "LAUNCHED" "REMOTEHOSTSTART" ))))) ;; account for a test that is running
   prereqs-not-met))

(define (runs:pretty-string lst)
  (map (lambda (t)
	 (if (not (vector? t))
	     (conc t)
	     (conc (db:test-get-testname t)"/"(db:test-get-item-path t) ":" (db:test-get-state t) "/" (db:test-get-status t))))