931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
|
(if (equal? thepath "/")
(begin
(debug:print-error 0 *default-log-port* "Unable to find megatest home directory.")
#f)
(loop (pathname-directory thepath)))))
))
(define (common:db-tmp-area-path)
(conc "/tmp/"
(current-user-name)
"/megatest_localdb/"
(common:get-testsuite-name)
"/"
(string-translate *toppath* "/" ".")
)
)
|
<
<
<
<
<
<
<
<
<
<
<
|
931
932
933
934
935
936
937
938
939
940
941
942
943
944
|
(if (equal? thepath "/")
(begin
(debug:print-error 0 *default-log-port* "Unable to find megatest home directory.")
#f)
(loop (pathname-directory thepath)))))
))
;;======================================================================
;; redefine for future cleanup (converge on area-name, the more generic
;;
(define common:get-area-name common:get-testsuite-name)
(define (common:get-db-tmp-area . junk)
|
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
|
(tsname (common:get-testsuite-name))
(dbpath (common:get-create-writeable-dir
(list (conc "/tmp/" (current-user-name)
"/megatest_localdb/"
tsname "/"
(string-translate toppath "/" "."))
(conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
"/megatest_localdb/"
tsname
(string-translate toppath "/" "."))
))))
(set! *db-cache-path* dbpath)
;; ensure megatest area has .mtdb
(let ((dbarea (conc *toppath* "/.mtdb")))
(if (not (file-exists? dbarea))
|
|
|
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
|
(tsname (common:get-testsuite-name))
(dbpath (common:get-create-writeable-dir
(list (conc "/tmp/" (current-user-name)
"/megatest_localdb/"
tsname "/"
(string-translate toppath "/" "."))
(conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
"/"(current-user-name) "/megatest_localdb/"
tsname
(string-translate toppath "/" "."))
))))
(set! *db-cache-path* dbpath)
;; ensure megatest area has .mtdb
(let ((dbarea (conc *toppath* "/.mtdb")))
(if (not (file-exists? dbarea))
|