400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
-
+
|
(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 (rdb: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)
(rtests:register-test db run-id test-name item-path)
(set! testdat (rdb: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))
'failed-to-insert))
|
580
581
582
583
584
585
586
587
588
589
590
591
592
593
|
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
|
+
+
|
(let ((db #f)
(keys #f))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(set! keys (rdb:get-keys db))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #f environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|