282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
-
+
|
(if (not (null? sorted-test-names))
(let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names)))
(thread-sleep! 0.1) ;; give other applications some time with the db
(let* ((test-record (hash-table-ref test-records hed))
(tconfig (tests:testqueue-get-testconfig test-record))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
(if m m 'normal)))
(if m (string->symbol m) 'normal)))
(waitons (tests:testqueue-get-waitons test-record))
(priority (tests:testqueue-get-priority test-record))
(itemdat (tests:testqueue-get-itemdat test-record)) ;; itemdat can be a string, list or #f
(items (tests:testqueue-get-items test-record))
(item-path (item-list->path itemdat))
(newtal (append tal (list hed)))
(calc-fails (lambda (prereqs-not-met)
|
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
|
-
+
+
+
+
|
(if can-run-more
(let* ((prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path mode: testmode))
(fails (calc-fails prereqs-not-met))
(non-completed (calc-not-completed prereqs-not-met)))
(debug:print 8 "INFO: can-run-more: " can-run-more
"\n prereqs-not-met: " (pretty-string prereqs-not-met)
"\n non-completed: " (pretty-string non-completed)
"\n fails: " (pretty-string fails))
"\n fails: " (pretty-string fails)
"\n testmode: " testmode
"\n (eq? testmode 'toplevel) " (eq? testmode 'toplevel)
"\n (null? non-completed) " (null? non-completed))
(cond
((or (null? prereqs-not-met) ;; all prereqs met, fire off the test
;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
(and (eq? testmode 'toplevel)
(null? non-completed)))
(let ((test-name (tests:testqueue-get-testname test-record)))
(setenv "MT_TEST_NAME" test-name) ;;
|
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
|
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
|
-
+
+
+
+
+
+
|
((and (not (null? fails))(eq? testmode 'normal))
(debug:print 1 "INFO: test " hed " (mode=" testmode ") has failed prerequisite(s); "
(string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
", removing it from to-do list")
(if (not (null? tal))
(loop (car tal)(cdr tal))))
(else
(debug:print 8 "ERROR: No handler for this condition, hed: " hed " fails: " (string-intersperse (map db:test-get-testname fails) ",") " testmode: " testmode " prereqs-not-met: " (pretty-string prereqs-not-met))
(debug:print 8 "ERROR: No handler for this condition.")
;; "\n hed: " hed
;; "\n fails: " (string-intersperse (map db:test-get-testname fails) ",")
;; "\n testmode: " testmode
;; "\n prereqs-not-met: " (pretty-string prereqs-not-met)
;; "\n items: " items)
(loop (car newtal)(cdr newtal)))))
;; if can't run more just loop with next possible test
(loop (car newtal)(cdr newtal)))))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)
(debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
|