751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
|
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
|
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (filter (lambda (testname)
;; (tests:match test-patts testname #f))
;; (map (lambda (testp)
;; (last (string-split testp "/")))
;; tests)))))
(define (tests:get-test-path-from-environment)
(and (getenv "MT_LINKTREE")
(getenv "MT_TARGET")
(getenv "MT_RUNNAME")
(getenv "MT_TEST_NAME")
(getenv "MT_ITEMPATH")
(conc (getenv "MT_LINKTREE") "/"
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME") "/"
(if (or (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))))))
(if (and (getenv "MT_LINKTREE")
(getenv "MT_TARGET")
(getenv "MT_RUNNAME")
(getenv "MT_TEST_NAME")
(getenv "MT_ITEMPATH"))
(conc (getenv "MT_LINKTREE") "/"
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME") "/"
(if (or (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))))
#f))
;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;; if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
|
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
|
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
|
-
+
|
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
(tcfg (if testexists
(read-config test-configf #f system-allowed
environ-patt: (if system-allowed
"pre-launch-env-vars"
#f))
#f)))
(if cache-file (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
(if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
(if tcfg (hash-table-set! *testconfigs* test-name tcfg))
(if (and testexists
cache-file
(file-write-access? cache-path))
(let ((tpath (conc cache-path "/.testconfig")))
(debug:print-info 1 "Caching testconfig for " test-name " in " tpath)
(configf:write-alist tcfg tpath)))
|