726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
|
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME") "/"
(if (or (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))))))
(define (tests:get-testconfig test-name test-registry system-allowed)
(let* ((test-path (hash-table-ref/default
test-registry test-name
(conc *toppath* "/tests/" test-name)))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
(cache-path (tests:get-test-path-from-environment))
(cache-exists (and cache-path (file-exists? (conc cache-path "/.testconfig"))))
(cache-file (conc cache-path "/.testconfig"))
(tcfg (if testexists
(or (and cache-exists
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to read " cache-file)
|
|
|
>
>
|
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
|
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME") "/"
(if (or (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))))))
(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
(let* ((test-path (hash-table-ref/default
test-registry test-name
(conc *toppath* "/tests/" test-name)))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
(cache-path (tests:get-test-path-from-environment))
(cache-exists (and cache-path
(not force-create) ;; if force-create then pretend there is no cache to read
(file-exists? (conc cache-path "/.testconfig"))))
(cache-file (conc cache-path "/.testconfig"))
(tcfg (if testexists
(or (and cache-exists
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to read " cache-file)
|