834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
;; prefer next hed to be from reg than tal.
(define runs:nothing-left-in-queue-count 0)
(define (runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path #!key (mode '(normal))(itemmaps #f)) ;; mode: testmode itemmaps: itemmaps)
(if (< (- (current-seconds) (runs:testdat-last-update testdat)) 10) ;; only refresh for this test if it has been at least 10 seconds
(begin
(debug:print 0 *default-log-port* "last-update=" (runs:testdat-last-update testdat) "(current-seconds)=" (current-seconds))
(runs:testdat-prereqs-not-met testdat))
;; (rmt:get-prereqs-not-met 46 '("r1") "y1" "" mode: '(itemmatch) itemmaps: #f)
(let* ((res (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode 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=" 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
|
|
>
>
>
|
>
|
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
|
;; prefer next hed to be from reg than tal.
(define runs:nothing-left-in-queue-count 0)
(define (runs:lazy-get-prereqs-not-met testdat run-id waitons hed item-path #!key (mode '(normal))(itemmaps #f)) ;; mode: testmode itemmaps: itemmaps)
(if (< (- (current-seconds) (runs:testdat-last-update testdat)) 10) ;; only refresh for this test if it has been at least 10 seconds
(begin
;; (debug:print 0 *default-log-port* "last-update=" (runs:testdat-last-update testdat) "(current-seconds)=" (current-seconds))
(runs:testdat-prereqs-not-met testdat))
;; (rmt:get-prereqs-not-met 46 '("r1") "y1" "" mode: '(itemmatch) itemmaps: #f)
(let* ((res (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: mode itemmaps: itemmaps)))
(debug:print 4 *default-log-port* "Get prereqs for " hed ", have " (length res)
" prereqs. last-update=" (runs:testdat-last-update testdat) " current-seconds=" (current-seconds)
" delta=" (- (current-seconds) (runs:testdat-last-update testdat)))
(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=" 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
|
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
|
;; every time though the loop increment the test/itempatt val.
;; when the min is > max-allowed and none running then force exit
;;
(define *max-tries-hash* (make-hash-table))
(define (runs:pretty-long-list lst)
(if (> (length lst) 8)(append (take lst 3)(list "...")) lst))
|
|
>
>
|
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
|
;; every time though the loop increment the test/itempatt val.
;; when the min is > max-allowed and none running then force exit
;;
(define *max-tries-hash* (make-hash-table))
(define (runs:pretty-long-list lst)
(if (> (length lst) 8)(append (take lst 3)(list "...")) lst))
(define *runs-testdat-cache* (make-hash-table)) ;; full/testname => testdat
;;======================================================================
;; 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)
|
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
|
extras)
extras)
'())))
(waitons (delete-duplicates (append (tests:testqueue-get-waitons test-record) extra-waits) equal?))
(newtal (append tal (list hed)))
(regfull (>= (length reg) reglen))
(num-running (rmt:get-count-tests-running-for-run-id run-id #t)) ;; fastmode=yes
(testdat (make-runs:testdat
hed: hed
tal: tal
reg: reg
reruns: reruns
test-record: test-record
test-name: test-name
item-path: item-path
jobgroup: jobgroup
waitons: waitons
testmode: testmode
newtal: newtal
itemmaps: itemmaps
;; prereqs-not-met: prereqs-not-met
)))
(runs:dat-regfull-set! runsdat regfull)
(if (> num-running 0)
(set! last-time-some-running (current-seconds)))
(if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
(hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
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
1640
|
extras)
extras)
'())))
(waitons (delete-duplicates (append (tests:testqueue-get-waitons test-record) extra-waits) equal?))
(newtal (append tal (list hed)))
(regfull (>= (length reg) reglen))
(num-running (rmt:get-count-tests-running-for-run-id run-id #t)) ;; fastmode=yes
(testdat (let ((oldtestdat (hash-table-ref/default *runs-testdat-cache* tfullname #f)))
(if oldtestdat
(begin
(runs:testdat-hed-set! oldtestdat hed)
(runs:testdat-tal-set! oldtestdat tal)
(runs:testdat-reg-set! oldtestdat reg)
(runs:testdat-reruns-set! oldtestdat reruns)
(runs:testdat-test-record-set! oldtestdat test-record)
(runs:testdat-newtal-set! oldtestdat newtal)
(if (not (equal? (runs:testdat-waitons oldtestdat) waitons))
(debug:print 0 *default-log-port* " waitons changed for runs:testdat"))
(if (not (equal? (runs:testdat-itemmaps oldtestdat) itemmaps))
(debug:print 0 *default-log-port* " itemmaps changed for runs:testdat"))
oldtestdat)
(let ((newtestdat (make-runs:testdat
hed: hed
tal: tal
reg: reg
reruns: reruns
test-record: test-record
test-name: test-name
item-path: item-path
jobgroup: jobgroup
waitons: waitons
testmode: testmode
newtal: newtal
itemmaps: itemmaps
;; prereqs-not-met: prereqs-not-met
)))
(hash-table-set! *runs-testdat-cache* tfullname newtestdat)
newtestdat)))))
(runs:dat-regfull-set! runsdat regfull)
(if (> num-running 0)
(set! last-time-some-running (current-seconds)))
(if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
(hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
|