15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
+
|
(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
-
+
|
(if (eq? *passnum* 0)
(begin
;; have to delete test records where NOT_STARTED since they can cause -keepgoing to
;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends
;; on test A but test B reached the point on being registered as NOT_STARTED and test
;; A failed for some reason then on re-run using -keepgoing the run can never complete.
(db:delete-tests-in-state db run-id "NOT_STARTED")
(db:set-tests-state-status db run-id test-names #f "FAIL" "NOT_STARTED" "FAIL")))
(rdb:set-tests-state-status db run-id test-names #f "FAIL" "NOT_STARTED" "FAIL")))
;; now add non-directly referenced dependencies (i.e. waiton)
(if (not (null? test-names))
(let loop ((hed (car test-names))
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(let* ((config (test:get-testconfig hed 'return-procs))
(waitons (string-split (let ((w (config-lookup config "requirements" "waiton")))
|
407
408
409
410
411
412
413
414
415
416
417
418
419
420
|
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
+
+
|
;; (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
(testdat (db:get-test-info db run-id test-name item-path)))
(if (not testdat)
(begin
;; ensure that the path exists before registering the test
(system (conc "mkdir -p " new-test-path))
(register-test db run-id test-name item-path)
(set! testdat (db:get-test-info db run-id test-name item-path))))
(change-directory test-path)
(case (if force ;; (args:get-arg "-force")
'NOT_STARTED
(if testdat
(string->symbol (test:get-state testdat))
|