| ︙ | | |
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
-
|
(vector header res)))
(define (runs:test-get-full-path test)
(let* ((testname (db:test-get-testname test))
(itempath (db:test-get-item-path test)))
(conc testname (if (equal? itempath "") "" (conc "(" itempath ")")))))
|
| ︙ | | |
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
-
-
+
+
|
(filter
(lambda (t)
(or (not (vector? t))
(not (equal? "COMPLETED" (db:test-get-state t)))))
prereqs-not-met)))
(pretty-string (lambda (lst)
(map (lambda (t)
(if (string? t)
t
(if (not (vector? t))
(conc t)
(conc (db:test-get-testname t) ":" (db:test-get-state t) "/" (db:test-get-status t))))
lst))))
(debug:print 6
"itemdat: " itemdat
"\n items: " items
"\n item-path: " item-path
"\n waitons: " waitons)
|
| ︙ | | |
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
|
+
+
-
+
|
(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 mode: testmode))
(fails (calc-fails prereqs-not-met))
(non-completed (calc-not-completed prereqs-not-met)))
(debug:print 8 "INFO: have-resources: " have-resources " prereqs-not-met: "
(string-intersperse
(map (lambda (t)
(if (not (vector? t))
(conc " WARNING: t is not a vector=" t )
(conc (db:test-get-state t)"/"(db:test-get-status t)))
(conc (db:test-get-state t) "/" (db:test-get-status t))))
prereqs-not-met) ", ") " fails: " fails)
;; 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?
(cond
((and have-resources
(or (null? prereqs-not-met)
(and (eq? testmode 'toplevel)
|
| ︙ | | |
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
|
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
|
+
-
+
-
-
-
+
+
+
|
(begin
(hash-table-set! *test-meta-updated* test-name #t)
(runs:update-test_meta db test-name test-conf)))
;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
(let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
(new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
(test-id (db:get-test-id db run-id test-name item-path))
(testdat (db:get-test-info db run-id test-name item-path))
(testdat (db:get-test-info-by-id db test-id)))
(test-id #f))
(rtests:register-test db run-id test-name item-path)
(set! testdat (db:get-test-info db run-id test-name item-path))))
(tests:register-test db run-id test-name item-path)
(set! test-id (db:get-test-id db run-id test-name item-path))
(set! testdat (db:get-test-info-by-id db test-id))))
(set! test-id (db:test-get-id testdat))
(change-directory test-path)
(case (if force ;; (args:get-arg "-force")
'NOT_STARTED
(if testdat
(string->symbol (test:get-state testdat))
'failed-to-insert))
|
| ︙ | | |