256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
;; #f ;; spare
)))
(for-each
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
(begin
(set! required-tests (cons waiton required-tests))
(set! test-names (append test-names (list waiton))))))
waitons)
(let ((remtests (delete-duplicates (append waitons tal))))
(if (not (null? remtests))
(loop (car remtests)(cdr remtests)))))))
(if (not (null? required-tests))
(debug:print 1 "INFO: Adding " required-tests " to the run queue"))
|
|
|
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
;; #f ;; spare
)))
(for-each
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
(begin
(set! required-tests (cons waiton required-tests))
(set! test-names (cons waiton test-names))))) ;; was an append, now a cons
waitons)
(let ((remtests (delete-duplicates (append waitons tal))))
(if (not (null? remtests))
(loop (car remtests)(cdr remtests)))))))
(if (not (null? required-tests))
(debug:print 1 "INFO: Adding " required-tests " to the run queue"))
|
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
(if (and have-resources
(null? prereqs-not-met))
;; no loop - drop though and use the loop at the bottom
(run:test db run-id runname keyvallst test-record flags #f)
;; else the run is stuck, temporarily or permanently
(let ((newtal (append tal (list hed))))
;; couldn't run, take a breather
(thread-sleep! 1)
(loop (car newtal)(cdr newtal))))))
;; case where an items came in as a list been processed
((and (list? items) ;; thus we know our items are already calculated
(not itemdat)) ;; and not yet expanded into the list of things to be done
(if (>= *verbosity* 1)(pp items))
;; (if (>= *verbosity* 5)
|
|
|
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
(if (and have-resources
(null? prereqs-not-met))
;; no loop - drop though and use the loop at the bottom
(run:test db run-id runname keyvallst test-record flags #f)
;; else the run is stuck, temporarily or permanently
(let ((newtal (append tal (list hed))))
;; couldn't run, take a breather
(thread-sleep! 4)
(loop (car newtal)(cdr newtal))))))
;; case where an items came in as a list been processed
((and (list? items) ;; thus we know our items are already calculated
(not itemdat)) ;; and not yet expanded into the list of things to be done
(if (>= *verbosity* 1)(pp items))
;; (if (>= *verbosity* 5)
|
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
|
(set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
items)
(loop (car tal)(cdr tal)))
;; 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
((or (procedure? items)(eq? items 'have-procedure))
(if (runs:can-run-more-tests db test-record)
(let ((items-list (items:get-items-from-config tconfig)))
(if (list? items-list)
(begin
(tests:testqueue-set-items! test-record items-list)
(loop hed tal))
(begin
(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
(exit 1))))
(let ((newtal (append tal (list hed))))
;; if can't run more tests, lets take a breather
(thread-sleep! 1)
(loop (car newtal)(cdr newtal)))))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)
|
|
>
>
>
>
>
|
|
|
|
|
|
|
|
|
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
|
(set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
items)
(loop (car tal)(cdr tal)))
;; 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
((or (procedure? items)(eq? items 'have-procedure))
(if (and (runs:can-run-more-tests db test-record)
(null? (db:get-prereqs-not-met db run-id waitons item-path)))
(let ((test-name (tests:testqueue-get-testname test-record)))
(setenv "MT_TEST_NAME" test-name) ;;
(setenv "MT_RUNNAME" runname)
(set-megatest-env-vars db run-id) ;; these may be needed by the launching process
(let ((items-list (items:get-items-from-config tconfig)))
(if (list? items-list)
(begin
(tests:testqueue-set-items! test-record items-list)
(loop hed tal))
(begin
(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
(exit 1)))))
(let ((newtal (append tal (list hed))))
;; if can't run more tests, lets take a breather
(thread-sleep! 1)
(loop (car newtal)(cdr newtal)))))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)
|