617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
tal
(if (null? tal) ;; must transfer from reg
(if (null? reg) '() (cdr reg))
(cdr tal))))
(define (runs:queue-next-reg tal reg n regfull)
(if regfull
(if (null? reg) '() (cdr reg))
(if (null? tal) ;; if tal is null and reg not full then '() as reg contents moved to tal
'()
reg)))
;; this is the list of parameters to the named loop "loop" near the top of runs:run-tests-queue, look around line 1216
;;
(define (runs:loop-values tal reg reglen regfull reruns)
|
|
|
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
tal
(if (null? tal) ;; must transfer from reg
(if (null? reg) '() (cdr reg))
(cdr tal))))
(define (runs:queue-next-reg tal reg n regfull)
(if regfull
(if (null? reg) '() (cdr reg)) ;; EXPLORE: reorder (cdr reg) such that looping is more efficient
(if (null? tal) ;; if tal is null and reg not full then '() as reg contents moved to tal
'()
reg)))
;; this is the list of parameters to the named loop "loop" near the top of runs:run-tests-queue, look around line 1216
;;
(define (runs:loop-values tal reg reglen regfull reruns)
|
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (rmt:find-and-mark-incomplete)
(let* ((run-info (rmt:get-run-info run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries"))
(max-concurrent-jobs (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
(reglen (if (number? reglen-in) reglen-in 1))
(last-time-incomplete (- (current-seconds) 900)) ;; force at least one clean up cycle
|
|
|
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (rmt:find-and-mark-incomplete)
(let* ((run-info (rmt:get-run-info run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries"))
(max-concurrent-jobs (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
(reglen (if (number? reglen-in) reglen-in 1))
(last-time-incomplete (- (current-seconds) 900)) ;; force at least one clean up cycle
|
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
|
(st (db:test-get-state trec)))
(if (not (equal? st "DELETED"))
(hash-table-set! test-registry (db:test-make-full-name tn ip) (string->symbol st)))))
tests-info)
(set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
(let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names))
(reg '()) ;; registered, put these at the head of tal
(reruns '()))
(runs:incremental-print-results run-id)
(if (not (null? reruns))(debug:print-info 4 *default-log-port* "reruns=" reruns))
|
|
|
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
|
(st (db:test-get-state trec)))
(if (not (equal? st "DELETED"))
(hash-table-set! test-registry (db:test-make-full-name tn ip) (string->symbol st)))))
tests-info)
(set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
(let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names))
(reg '()) ;; registered, put these at the head of tal
(reruns '()))
(runs:incremental-print-results run-id)
(if (not (null? reruns))(debug:print-info 4 *default-log-port* "reruns=" reruns))
|