diff options
| -rwxr-xr-x | src/guile/myra-test-utils/driver.scm | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/src/guile/myra-test-utils/driver.scm b/src/guile/myra-test-utils/driver.scm index 0369fe1..8331463 100755 --- a/src/guile/myra-test-utils/driver.scm +++ b/src/guile/myra-test-utils/driver.scm @@ -30,7 +30,7 @@ #:use-module ((ice-9 format) #:select (format)) #:use-module ((ice-9 getopt-long) #:select (getopt-long option-ref)) #:use-module ((ice-9 pretty-print) #:select (pretty-print)) - #:use-module ((ice-9 regex) #:select (string-match)) + #:use-module ((ice-9 regex) #:select (string-match match:substring)) #:use-module ((srfi srfi-1) #:select (filter-map)) #:use-module ((srfi srfi-19) #:prefix s19:) #:use-module ((srfi srfi-26) #:select (cut)) @@ -42,7 +42,7 @@ (define (show-help) (display "Usage: - test-driver --test-name=NAME [--log-file=PATH] [--trs-file=PATH] + test-driver [--test-name=NAME] [--log-file=PATH] [--trs-file=PATH] [--expect-failure={yes|no}] [--color-tests={yes|no}] [--select=REGEXP] [--exclude=REGEXP] [--errors-only={yes|no}] [--enable-hard-errors={yes|no}] [--brief={yes|no}}] @@ -247,7 +247,11 @@ cases based on their names." (let* ((log (and=> (option 'log-file #f) (cut open-file <> "w0"))) (trs (and=> (option 'trs-file #f) (cut open-file <> "wl"))) (out (duplicate-port (current-output-port) "wl")) - (test-name (option 'test-name #f)) + (test-filename (car (option '() #f))) + (match-vec (string-match "([^/]*)\\.(scm|go)$" test-filename)) + (test-filename-base (match:substring match-vec 1)) + (test-dir (canonicalize-path (dirname test-filename))) + (test-name (option 'test-name test-filename)) (select (option 'select #f)) (exclude (option 'exclude #f)) (test-specifiers (filter-map @@ -284,7 +288,11 @@ convenient interactive line editing and input history.\n\n" #:out-port out #:trs-port trs) (s64:test-apply test-specifier (lambda _ - (load-from-path test-name))))) + (set! %load-path + (cons test-dir %load-path)) + (set! %load-compiled-path + (cons test-dir %load-compiled-path)) + (load-from-path test-filename-base))))) (and=> log close-port) (and=> trs close-port) (close-port out)))) |