Functions for getting path relative to base or work dir
This commit is contained in:
parent
905ff218f8
commit
8f0849d1cb
28
utest.scm
28
utest.scm
@ -358,13 +358,33 @@
|
|||||||
(format "~a/~a" (utest/base-path) base))
|
(format "~a/~a" (utest/base-path) base))
|
||||||
follow-symlink))
|
follow-symlink))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Get path relative to base
|
||||||
|
;;;
|
||||||
|
(define (utest/base-rel path)
|
||||||
|
(if (absolute-file-name? path)
|
||||||
|
path
|
||||||
|
(path->absolute
|
||||||
|
(if (string-null? path)
|
||||||
|
(utest/base-path)
|
||||||
|
(string-append (utest/base-path) "/" path)))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Get path relative to work
|
||||||
|
;;;
|
||||||
|
(define (utest/work-rel path)
|
||||||
|
(if (absolute-file-name? path)
|
||||||
|
path
|
||||||
|
(path->absolute
|
||||||
|
(if (string-null? path)
|
||||||
|
(utest/work-path)
|
||||||
|
(string-append (utest/work-path) "/" path)))))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Find files in testbench base directory
|
;;; Find files in testbench base directory
|
||||||
|
;;;
|
||||||
(define* (utest/find-files rx #:key (base "") (follow-symlink #f))
|
(define* (utest/find-files rx #:key (base "") (follow-symlink #f))
|
||||||
(let* ((base (path->absolute
|
(let* ((base (utest/base-rel base))
|
||||||
(if (string-null? base)
|
|
||||||
(utest/base-path)
|
|
||||||
(format "~a/~a" (utest/base-path) base))))
|
|
||||||
(ls (list-dir base)))
|
(ls (list-dir base)))
|
||||||
(filter (lambda (f)
|
(filter (lambda (f)
|
||||||
(and (not (string=? f "."))
|
(and (not (string=? f "."))
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user