290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
(let ((have-resources (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
(prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path)))
;; Don't know at this time if the test have been launched at some time in the past
;; i.e. is this a re-launch?
(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! 0.5)
(loop (car newtal)(cdr newtal))))))
;; case where an items came in as a list been processed
|
>
|
>
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
(let ((have-resources (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
(prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path)))
;; Don't know at this time if the test have been launched at some time in the past
;; i.e. is this a re-launch?
(if (and have-resources
(null? prereqs-not-met))
;; no loop - drop though and use the loop at the bottom
(if (patt-list-match item-path item-patts)
(run:test db run-id runname keyvallst test-record flags #f)
(debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts))
;; else the run is stuck, temporarily or permanently
(let ((newtal (append tal (list hed))))
;; couldn't run, take a breather
(thread-sleep! 0.5)
(loop (car newtal)(cdr newtal))))))
;; case where an items came in as a list been processed
|
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
339
340
341
342
|
;; (print "items: ") (pp (item-assoc->item-list items))
;; (print "itemstable: ")(pp (item-table->item-list itemstable))))
(for-each
(lambda (my-itemdat)
(let* ((new-test-record (let ((newrec (make-tests:testqueue)))
(vector-copy! test-record newrec)
newrec))
(my-item-path (item-list->path my-itemdat))
;; 3/25/2012 - this match is *always* returning true I believe. Or is it the tests that are not being handled?
;;
(item-matches (if item-patts ;; here we are filtering for matches with -itempatt
(let ((res #f)) ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is %
(for-each
(lambda (patt)
(if (string-search (glob->regexp
(string-translate patt "%" "*"))
item-path)
(set! res #t)))
(string-split item-patts ","))
res)
#t)))
(if item-matches ;; yes, we want to process this item
(let ((newtestname (conc hed "/" my-item-path))) ;; test names are unique on testname/item-path
(tests:testqueue-set-items! new-test-record #f)
(tests:testqueue-set-itemdat! new-test-record my-itemdat)
(tests:testqueue-set-item_path! new-test-record my-item-path)
(hash-table-set! test-records newtestname new-test-record)
(set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
items)
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
;; (print "items: ") (pp (item-assoc->item-list items))
;; (print "itemstable: ")(pp (item-table->item-list itemstable))))
(for-each
(lambda (my-itemdat)
(let* ((new-test-record (let ((newrec (make-tests:testqueue)))
(vector-copy! test-record newrec)
newrec))
(my-item-path (item-list->path my-itemdat)))
(if (patt-list-match my-item-path item-patts) ;; yes, we want to process this item
(let ((newtestname (conc hed "/" my-item-path))) ;; test names are unique on testname/item-path
(tests:testqueue-set-items! new-test-record #f)
(tests:testqueue-set-itemdat! new-test-record my-itemdat)
(tests:testqueue-set-item_path! new-test-record my-item-path)
(hash-table-set! test-records newtestname new-test-record)
(set! tal (cons newtestname tal)))))) ;; since these are itemized create new test names testname/itempath
items)
|