︙ | | | ︙ | |
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
(currtime (current-seconds)))
(if (> (- currtime lasttime) waitval)
(begin
(hash-table-set! *runs:denoise* key currtime)
#t)
#f)))
(define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)
;; Take advantage of a good place to exit if running the one-pass methodology
(if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)
(args:get-arg "-one-pass"))
(exit 0))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
|
(currtime (current-seconds)))
(if (> (- currtime lasttime) waitval)
(begin
(hash-table-set! *runs:denoise* key currtime)
#t)
#f)))
(define *last-test-launch* 0)
(define *too-soon-delays* (make-hash-table))
;; to-soon delay, when matching event happened in less than dseconds delay wseconds
;;
(define (runs:too-soon-delay key dseconds wseconds)
(let* ((last-time (hash-table-ref/default *too-soon-delays* key #f)))
(if (and last-time
(< (- (current-seconds) last-time) dseconds))
(begin
(if (runs:lownoise (conc "too-soon-delay"key) 60)
(debug:print-info 0 *default-log-port* "Polling throttle for "key))
(thread-sleep! wseconds)))
(hash-table-set! *too-soon-delays* key (current-seconds))))
(define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)
;; Take advantage of a good place to exit if running the one-pass methodology
(if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)
(args:get-arg "-one-pass"))
(exit 0))
|
︙ | | | ︙ | |
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
|
(not (member 'exclusive testmode)))))
;; (hash-table-delete! *max-tries-hash* (db:test-make-full-name test-name item-path))
;; we are going to reset all the counters for test retries by setting a new hash table
;; this means they will increment only when nothing can be run
(set! *max-tries-hash* (make-hash-table))
(run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry runsdat testdat)
(runs:incremental-print-results run-id)
(hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'running)
(runs:shrink-can-run-more-tests-count runsdat) ;; DELAY TWEAKER (still needed?)
;; (thread-sleep! *global-delta*)
(if (or (not (null? tal))(not (null? reg)))
(runs:loop-values tal reg reglen regfull reruns) ;; hed should be dropped at this time
#f))
|
>
|
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
|
(not (member 'exclusive testmode)))))
;; (hash-table-delete! *max-tries-hash* (db:test-make-full-name test-name item-path))
;; we are going to reset all the counters for test retries by setting a new hash table
;; this means they will increment only when nothing can be run
(set! *max-tries-hash* (make-hash-table))
(run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry runsdat testdat)
(set! *last-test-launch* (current-seconds))
(runs:incremental-print-results run-id)
(hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'running)
(runs:shrink-can-run-more-tests-count runsdat) ;; DELAY TWEAKER (still needed?)
;; (thread-sleep! *global-delta*)
(if (or (not (null? tal))(not (null? reg)))
(runs:loop-values tal reg reglen regfull reruns) ;; hed should be dropped at this time
#f))
|
︙ | | | ︙ | |
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
|
(begin
(if (runs:lownoise "too-tight-loop" 5)
(debug:print-info 2 *default-log-port* "Excessively fast loop, delaying 1/2 second"))
(thread-sleep! 0.5)))
(set! *last-loop-time-ms* (current-milliseconds))
(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)))
;; (debug:print 0 *default-log-port* "max-tries-hash: " (hash-table->alist *max-tries-hash*))
|
|
>
>
>
>
|
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
|
(begin
(if (runs:lownoise "too-tight-loop" 5)
(debug:print-info 2 *default-log-port* "Excessively fast loop, delaying 1/2 second"))
(thread-sleep! 0.5)))
(set! *last-loop-time-ms* (current-milliseconds))
(runs:dat-regfull-set! runsdat regfull)
(if (> (- (current-seconds) *last-test-launch*) 5) ;; be pretty aggressive for five seconds after
(runs:too-soon-delay (conc "loop delay " hed) 1 0.6) ;; starting a test then apply more delay
(runs:too-soon-delay (conc "loop delay " hed) 1 0.1))
(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)))
;; (debug:print 0 *default-log-port* "max-tries-hash: " (hash-table->alist *max-tries-hash*))
|
︙ | | | ︙ | |
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
|
))) ;; end loop on sorted test names
;; this is the point where everything is launched and now you can mark the run in metadata table as all launched
(rmt:set-var (conc "lunch-complete-" run-id) "yes")
;; now *if* -run-wait we wait for all tests to be done
;; Now wait for any RUNNING tests to complete (if in run-wait mode)
;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
(thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
(let wait-loop ((num-running (rmt:get-count-tests-running-for-run-id run-id))
(prev-num-running 0))
;; (debug:print-info 13 *default-log-port* "num-running=" num-running ", prev-num-running=" prev-num-running)
(if (and (or (args:get-arg "-run-wait")
(equal? (configf:lookup *configdat* "setup" "run-wait") "yes"))
(> num-running 0))
|
|
|
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
|
))) ;; end loop on sorted test names
;; this is the point where everything is launched and now you can mark the run in metadata table as all launched
(rmt:set-var (conc "lunch-complete-" run-id) "yes")
;; now *if* -run-wait we wait for all tests to be done
;; Now wait for any RUNNING tests to complete (if in run-wait mode)
;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
(thread-sleep! 0.1) ;; I think there is a race condition here. Let states/statuses settle
(let wait-loop ((num-running (rmt:get-count-tests-running-for-run-id run-id))
(prev-num-running 0))
;; (debug:print-info 13 *default-log-port* "num-running=" num-running ", prev-num-running=" prev-num-running)
(if (and (or (args:get-arg "-run-wait")
(equal? (configf:lookup *configdat* "setup" "run-wait") "yes"))
(> num-running 0))
|
︙ | | | ︙ | |