| ︙ | | | ︙ | |
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
|
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
(configf:lookup *configdat* "setup" "testsuite" )
(getenv "MT_TESTSUITE_NAME")
(if (string? *toppath* )
(pathname-file *toppath*)
#f))) ;; (pathname-file (current-directory)))))
;; safe getting of toppath
(define (common:get-toppath areapath)
(or *toppath*
(if areapath
(begin
(set! *toppath* areapath)
|
|
|
>
>
|
|
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
|
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
(configf:lookup *configdat* "setup" "testsuite" )
(getenv "MT_TESTSUITE_NAME")
(pathname-file (or (if (string? *toppath* )
(pathname-file *toppath*)
#f)
(common:get-topath #f)))
"please-set-setup-area-name")) ;; (pathname-file (current-directory)))))
;; safe getting of toppath
(define (common:get-toppath areapath)
(or *toppath*
(if areapath
(begin
(set! *toppath* areapath)
|
| ︙ | | | ︙ | |
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
|
*db-cache-path*
(if *toppath* ;; common:get-create-writeable-dir
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path* ", exn=" exn)
(exit 1))
(let ((dbpath (common:get-create-writeable-dir
(list (conc "/tmp/" (current-user-name)
"/megatest_localdb/"
(common:get-testsuite-name) "/"
(string-translate *toppath* "/" ".")))))) ;; #t))))
(set! *db-cache-path* dbpath)
dbpath))
#f)))
(define (common:get-area-path-signature)
(message-digest-string (md5-primitive) *toppath*))
(define (common:get-signature str)
(message-digest-string (md5-primitive) str))
|
>
|
|
|
>
>
>
>
|
|
>
|
|
|
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
|
*db-cache-path*
(if *toppath* ;; common:get-create-writeable-dir
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path* ", exn=" exn)
(exit 1))
(let* ((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)
dbpath))
#f)))
(define (common:get-area-path-signature)
(message-digest-string (md5-primitive) *toppath*))
(define (common:get-signature str)
(message-digest-string (md5-primitive) str))
|
| ︙ | | | ︙ | |
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
|
(tal (cdr dirs)))
(let ((res (or (and (directory? hed)
(file-write-access? hed)
hed)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "could not create " hed ", this might cause problems down the road. exn=" exn)
#f)
(create-directory hed #t)))))
(if (and (string? res)
(directory? res))
res
(if (null? tal)
#f
|
|
>
|
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
|
(tal (cdr dirs)))
(let ((res (or (and (directory? hed)
(file-write-access? hed)
hed)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "could not create " hed
", this might cause problems down the road. exn=" exn)
#f)
(create-directory hed #t)))))
(if (and (string? res)
(directory? res))
res
(if (null? tal)
#f
|
| ︙ | | | ︙ | |
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
|
;;
(define (common:lazy-modification-time fpath)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "Failed to get modifcation time for " fpath ", treating it as zero. exn=" exn)
0)
(file-modification-time fpath)))
|
>
|
>
|
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
|
;;
(define (common:lazy-modification-time fpath)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "Failed to get modifcation time for " fpath ", treating it as zero. exn=" exn)
0)
(if (file-exists? fpath)
(file-modification-time fpath)
0)))
;; find timestamp of newest file associated with a sqlite db file
(define (common:lazy-sqlite-db-modification-time fpath)
(let* ((glob-list (handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "Failed to glob " fpath "*, exn=" exn)
|
| ︙ | | | ︙ | |