Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-wip |
| Files: | files | file ages | folders |
| SHA1: |
b7b562b7b3af9671b0c986dcfdd98972 |
| User & Date: | matt on 2019-10-18 08:00:59 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-10-18
| ||
| 08:27 | wip check-in: 6871dc0b79 user: matt tags: v1.65-wip | |
| 08:00 | wip check-in: b7b562b7b3 user: matt tags: v1.65-wip | |
|
2019-10-16
| ||
| 17:59 | refactoring in flight. does not compile. check-in: 028f0d8c40 user: mrwellan tags: v1.65-wip | |
Changes
Modified common.scm from [e293d1548a] to [f59f8f3c80].
| ︙ | ︙ | |||
1060 1061 1062 1063 1064 1065 1066 | exn #f (pathname-directory (pathname-directory (pathname-directory exe-path)))) #f))) | < < < < < < < < < < < < < < < < < < < < < < < | 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 | exn #f (pathname-directory (pathname-directory (pathname-directory exe-path)))) #f))) ;; return the youngest timestamp . filename ;; (define (common:get-youngest glob-list) (let ((all-files (apply append (map (lambda (patt) (handle-exceptions exn |
| ︙ | ︙ |
Modified commonmod.scm from [0bf160ddb9] to [7e8e367734].
| ︙ | ︙ | |||
38 39 40 41 42 43 44 45 46 47 48 |
(areapath (alldat-areapath alldat)))
(or (configf:lookup configdat "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
(configf:lookup configdat "setup" "testsuite" )
(get-environment-variable "MT_TESTSUITE_NAME")
(if (string? areapath )
(pathname-file areapath)
#f)))) ;; (pathname-file (current-directory)))))
;; (define common:get-area-name common:get-area-name)
(define (common:get-db-tmp-area alldat)
| > > > > > > > > > > > > > > > > > > > > > > > > | > | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
(areapath (alldat-areapath alldat)))
(or (configf:lookup configdat "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
(configf:lookup configdat "setup" "testsuite" )
(get-environment-variable "MT_TESTSUITE_NAME")
(if (string? areapath )
(pathname-file areapath)
#f)))) ;; (pathname-file (current-directory)))))
;; return first path that can be created or already exists and is writable
;;
(define (common:get-create-writeable-dir dirs)
(if (null? dirs)
#f
(let loop ((hed (car dirs))
(tal (cdr dirs)))
(let ((res (or (and (directory? hed)
(file-write-access? hed)
hed)
(handle-exceptions
exn
(begin
;; TODO add print of exception here
;; (debug:print-info 0 *default-log-port* "could not create " hed ", this might cause problems down the road.")
#f)
(create-directory hed #t)))))
(if (and (string? res)
(directory? res))
res
(if (null? tal)
#f
(loop (car tal)(cdr tal))))))))
;; (define common:get-area-name common:get-area-name)
(define (common:get-db-tmp-area alldat)
(let* ((dbdir #f)
(log-port (alldat-log-port alldat)))
(if (alldat-tmppath alldat)
(alldat-tmppath alldat)
(if (alldat-areapath alldat) ;; common:get-create-writeable-dir
(handle-exceptions
exn
(begin
(debug:print-error 0 log-port "Couldn't create path to " dbdir)
(exit 1))
(let ((dbpath (common:get-create-writeable-dir
(list (conc "/tmp/" (current-user-name)
"/megatest_localdb/"
(common:get-area-name alldat) "/"
(string-translate (alldat-areapath alldat) "/" ".")))))) ;; #t))))
(set! dbdir dbpath)
|
| ︙ | ︙ |