From 8f0849d1cb518cc82102842e4637f43119da8771 Mon Sep 17 00:00:00 2001 From: Nikolay Puzanov Date: Tue, 12 Jul 2022 18:44:49 +0300 Subject: [PATCH] Functions for getting path relative to base or work dir --- utest.scm | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/utest.scm b/utest.scm index 7de508b..4e17893 100755 --- a/utest.scm +++ b/utest.scm @@ -358,13 +358,33 @@ (format "~a/~a" (utest/base-path) base)) 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 +;;; (define* (utest/find-files rx #:key (base "") (follow-symlink #f)) - (let* ((base (path->absolute - (if (string-null? base) - (utest/base-path) - (format "~a/~a" (utest/base-path) base)))) + (let* ((base (utest/base-rel base)) (ls (list-dir base))) (filter (lambda (f) (and (not (string=? f "."))