| ︙ | | |
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
-
+
+
+
+
+
|
(last-load-check-time 0)
(last-jobs-check-time 0)
)
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
waitons testmode newtal
itemmaps
(prereqs-not-met #f)
(last-update 0) ;;
)
;; look in the $MT_RUN_AREA_HOME/.softlocks directory for key-host-pid.softlock files
;; - remove any that are over 3600 seconds old
;; - if there are any that are younger than 10 seconds
;; * sleep 10 seconds
;; * touch my key-host-pid.softlock file
;; * return
|
| ︙ | | |
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
|
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
-
+
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
|
;; => review of a previously seen test is higher priority of never visited test
;; reg - list of previously visited tests
;; tal - list of never visited tests
;; prefer next hed to be from reg than tal.
(define runs:nothing-left-in-queue-count 0)
;; cache the result of get-prereqs-not-met and don't call it if called in past 10 seconds
;; NOTE: This is assuming that testdat is highly specific to this test
;;
(define (runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path #!key (mode '(normal))(itemmaps #f))
;; mode: testmode itemmaps: itemmaps)
(if (and (runs:testdat-prereqs-not-met testdat)
(< (- (current-seconds) (runs:testdat-last-update testdat)) 10)) ;;; only refresh for this test if
;;; it has been at least 10 seconds
(runs:testdat-prereqs-not-met testdat) ;; return the cached result
(let* ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode itemmaps: itemmaps)))
(runs:testdat-prereqs-not-met-set! testdat res)
(runs:testdat-last-update-set! testdat (current-seconds))
res)))
;;======================================================================
;; runs:expand-items is called by runs:run-tests-queue
;;======================================================================
;;
;; return value of runs:expand-items is passed back to runs-tests-queue and is fed to named loop with this signature:
;; (let loop ((hed (car sorted-test-names))
;; (tal (cdr sorted-test-names))
;; (reg '()) ;; registered, put these at the head of tal
;; (reruns '()))
(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps)
(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs
run-id waitons item-path testmode test-record
can-run-more items runname tconfig reglen test-registry
test-records itemmaps testdat)
(let* ((loop-list (list hed tal reg reruns))
(prereqs-not-met (runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path
(prereqs-not-met (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps)))
mode: testmode itemmaps: itemmaps))
(if (list? res)
res
(begin
(debug:print 0 *default-log-port*
"ERROR: rmt:get-prereqs-not-met returned non-list!\n"
" res=" res " run-id=" run-id " waitons=" waitons " hed=" hed " item-path=" item-path " testmode=" testmode " itemmaps=" itemmaps)
'()))))
(have-itemized (not (null? (lset-intersection eq? testmode '(itemmatch itemwait)))))
;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
waitons))
waitons)))
)
|
| ︙ | | |
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
|
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
|
-
+
+
|
(if (> (length lst) 8)(append (take lst 3)(list "...")) lst))
;;======================================================================
;; runs:run-tests-queue is called by runs:run-tests
;;======================================================================
;;
;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)
(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 *default-log-port* "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (rmt:find-and-mark-incomplete)
|
| ︙ | | |
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
|
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
|
-
-
+
+
-
-
-
+
+
+
+
-
|
;;
((not items)
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-2")
(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))
;; gonna try a strategy change here.
;; side effect is to save the prereqs in the struct
(runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path
;;
;; check if can run more tests. if yes, continue, if no, rest until can run more
;; look at the test jobgroup and tot jobs running
;;
|
| ︙ | | |
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
|
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
|
+
+
-
+
|
;; wait for load here
(if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
(loop-can-run-more (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)
(- remtries 1)))))))
)))))
;; I'm not clear on why prereqs are gathered here TODO: verfiy this is needed
(runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path
mode: testmode
(runs:testdat-prereqs-not-met-set! testdat (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))
itemmaps: itemmaps)
;; I'm not clear on why we'd capture running job counts here TODO: verify this is needed
(runs:dat-can-run-more-tests-set! runsdat (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))
(let ((loop-list (runs:process-expanded-tests runsdat testdat))) ;; in process-expanded-tests ultimately run:test -> launch-test -> test actually running
(if loop-list (apply loop loop-list))))
|
| ︙ | | |
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
|
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
|
-
+
+
-
+
+
+
+
-
+
-
-
|
;; 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
;; EXPAND ITEMS
((or (procedure? items)(eq? items 'have-procedure))
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-4")
(let ((can-run-more #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)))
(if (not can-run-more) #;(and (list? can-run-more)
(if (not can-run-more) #;(and (list? can-run-more) ;; IDEA, this mechanism may have had some value,
;;; make it configurable to test pros/cons TODO
(car can-run-more))
(let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps))) ;; itemized test expanded here
(let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs
run-id waitons item-path testmode test-record
can-run-more items runname tconfig reglen test-registry
test-records itemmaps testdat)))
(if loop-list
(apply loop loop-list)
(debug:print-info 4 *default-log-port* " -- Can't expand hed="hed)
(debug:print-info 4 *default-log-port* " -- Can't expand hed="hed)))
)
)
|
| ︙ | | |