Functions for getting path relative to base or work dir

This commit is contained in:
Nikolay Puzanov 2022-07-12 18:44:49 +03:00
parent 905ff218f8
commit 8f0849d1cb

View File

@ -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 "."))