44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
test-patts required-tests test-registry
registry-mutex flags keyvals run-info all-tests-registry
can-run-more-tests
((can-run-more-tests-count 0) : fixnum))
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
(define (runs:get-mt-env-alist run-id runname target testname itempath)
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
`(("MT_TEST_NAME" . ,testname)
("MT_ITEMPATH" . ,itempath)
|
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
(defstruct runs:dat
reglen regfull
runname max-concurrent-jobs run-id
test-patts required-tests test-registry
registry-mutex flags keyvals run-info all-tests-registry
can-run-more-tests
((can-run-more-tests-count 0) : fixnum)
(last-runners-check 0) ;; time when we last checked number of runners
(last-runners-count #f) ;;
(runner-registered #f) ;; have I registered myself?
(run-skip-count 0) ;; how many times have I skipped running sequentially
)
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
(define (runs:print-parallel-runners-state state num-registered last-registered skip-count)
(debug:print-info 0 *default-log-port* "runs:parallel-runners-mgmt, state=" state
", num-registered=" num-registered ", last-registered=" last-registered
", skip-count=" skip-count))
(define (runs:print-parallel-runners-state2 state num-registered last-runners-count skip-count)
(debug:print-info 0 *default-log-port* "runs:parallel-runners-mgmt, state=" state
", num-registered=" num-registered ", last-runners-count=" last-runners-count
", skip-count=" skip-count))
(define (runs:parallel-runners-mgmt rdat)
(let ((time-to-check 2.8) ;; 28
(time-to-wait 3.0))
(if (> (- (current-seconds) (runs:dat-last-runners-check rdat)) time-to-check) ;; time to check
(let* ((num-registered (or (rmt:get-var "num-runners") 0))
(last-runners-count (runs:dat-last-runners-count rdat))
(skip-count (runs:dat-run-skip-count rdat)))
(cond
;; first time in
((not last-runners-count)
(runs:print-parallel-runners-state2 "A" num-registered last-runners-count skip-count)
(rmt:set-var "num-runners" 1)
(runs:dat-last-runners-count-set! rdat num-registered)
(runs:dat-run-skip-count-set! rdat 0))
;; too many waits, decrement num-runners and continue on
((> (runs:dat-run-skip-count rdat) 3)
(runs:print-parallel-runners-state2 "B" num-registered last-runners-count skip-count)
(rmt:dec-var "num-runners")
(runs:dat-run-skip-count-set! rdat 0))
;; too many running, take a break
((> num-registered last-runners-count)
(runs:print-parallel-runners-state2 "C" num-registered last-runners-count skip-count)
(rmt:dec-var "num-runners")
(debug:print-info 0 *default-log-port*
"Too many running (" num-registered
"), last-count=" last-runners-count " waiting... ")
(thread-sleep! time-to-wait)
(runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1)))
;; we have been in waiting mode, do not increment again as we already did that
((> skip-count 0)
(runs:print-parallel-runners-state2 "D" num-registered last-runners-count skip-count)
(runs:dat-run-skip-count-set! rdat 0)
;; (runs:dat-last-runners-count-set! rdat num-registered)
)
;; skip count is zero, not too many running, this is transition into running
(else
(runs:print-parallel-runners-state2 "E" num-registered last-runners-count skip-count)
(rmt:inc-var "num-runners")
#;(runs:dat-run-skip-count-set! rdat 0)))))))
;; (define (runs:parallel-runners-mgmt rdat)
;; (let ((time-to-check 2.8) ;; 28
;; (time-to-wait 3.0))
;; (if (> (- (current-seconds) (runs:dat-last-runners-check rdat)) time-to-check) ;; time to check
;; (let* ((num-registered (or (rmt:get-var "num-runners") 0))
;; (last-registered (or (rmt:get-var "runner-change-time") 0))
;; (skip-count (runs:dat-run-skip-count rdat)))
;; (cond
;; ;; consider this the beginning of time
;; ((eq? num-registered 0)
;; (runs:print-parallel-runners-state "A" num-registered last-registered skip-count)
;; (rmt:set-var "num-runners" 1) ;; potential bug - not ACID
;; (rmt:set-var "runner-change-time" (current-seconds))
;; (runs:dat-last-runners-check-set! rdat (current-seconds))
;; (runs:dat-runner-registered-set! rdat #t)
;; (runs:dat-run-skip-count-set! rdat 0))
;; ;; have headroom to run another
;; ((< num-registered 3)
;; (runs:print-parallel-runners-state "B" num-registered last-registered skip-count)
;; (rmt:inc-var "num-runners")
;; (rmt:set-var "runner-change-time" (current-seconds))
;; (runs:dat-last-runners-check-set! rdat (current-seconds))
;; (runs:dat-run-skip-count-set! rdat 0))
;; ;; we've waited too many rounds, gonna force a round
;; ((> (runs:dat-run-skip-count rdat) 3)
;; (runs:print-parallel-runners-state "C" num-registered last-registered skip-count)
;; (rmt:set-var "num-runners" 1)
;; ;; (rmt:set-var "runner-change-time" (current-seconds))
;; (runs:dat-last-runners-check-set! rdat (current-seconds))
;; (runs:dat-run-skip-count-set! rdat 0))
;; ;; have too many runners working, but this is the first time to wait since doing some work
;; ((eq? (runs:dat-run-skip-count rdat) 0) ;; and num-registered is >= 3
;; (runs:print-parallel-runners-state "D" num-registered last-registered skip-count)
;; (if (not (eq? (runs:dat-last-runners-check rdat) 0)) ;; do not decrement if we've never incremented
;; (begin
;; (rmt:dec-var "num-runners")
;; #;(rmt:set-var "runner-change-time" (current-seconds))))
;; (runs:dat-last-runners-check-set! rdat (current-seconds))
;; (runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1))
;; (debug:print-info 0 *default-log-port* "Too many runners working (" num-registered
;; "). Resting for 30 seconds.")
;; (thread-sleep! time-to-wait)
;; (runs:parallel-runners-mgmt rdat))
;; ;; ok, keep waiting
;; (else
;; (runs:print-parallel-runners-state "E" num-registered last-registered skip-count)
;; (thread-sleep! time-to-wait)
;; (runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1))
;; (runs:parallel-runners-mgmt rdat)))))))
(define (runs:get-mt-env-alist run-id runname target testname itempath)
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
`(("MT_TEST_NAME" . ,testname)
("MT_ITEMPATH" . ,itempath)
|
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
|
"\n waitons: " waitons
"\n num-retries: " num-retries
"\n reruns: " reruns
"\n regfull: " regfull
"\n reglen: " reglen
"\n length reg: " (length reg)
)
;; check for hed in waitons => this would be circular, remove it and issue an
;; error
(if (member test-name waitons)
(begin
(debug:print-error 0 *default-log-port* "test " test-name " has listed itself as a waiton, please correct this!")
(set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))
|
>
>
|
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
|
"\n waitons: " waitons
"\n num-retries: " num-retries
"\n reruns: " reruns
"\n regfull: " regfull
"\n reglen: " reglen
"\n length reg: " (length reg)
)
(runs:parallel-runners-mgmt runsdat)
;; check for hed in waitons => this would be circular, remove it and issue an
;; error
(if (member test-name waitons)
(begin
(debug:print-error 0 *default-log-port* "test " test-name " has listed itself as a waiton, please correct this!")
(set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))
|