diff options
| -rwxr-xr-x | bin/run64 | 27 |
1 files changed, 25 insertions, 2 deletions
diff --git a/bin/run64 b/bin/run64 index bf54d3f..5e2a52e 100755 --- a/bin/run64 +++ b/bin/run64 @@ -1,7 +1,7 @@ #!r6rs ;;; -*- mode: scheme -*- ;;; run64 --- SRFI-64 test runner -;;; Copyright © 2022, 2025 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2025–2026 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of run64. ;;; @@ -248,6 +248,28 @@ object instead of the list element." obj1 (highlit obj1))))) +(define (maybe-make-path-a-directory path) + "Return PATH as a directory name. If not possible, return it as is." + ;; This function is unfortunately not very portable or robust. + (cond-expand + (guile + (if (string-suffix? file-name-separator-string path) + path + (string-append path file-name-separator-string))) + (else path))) + +(define (maybe-make-path-relative path) + "Return PATH relative to current directory. If that is not possible, return it as +is." + ;; This function is unfortunately not very portable or robust. + (cond-expand + (guile + (let ((working-directory (maybe-make-path-a-directory (getcwd)))) + (if (string-prefix? working-directory path) + (substring path (string-length working-directory)) + path))) + (else path))) + (define (main args) (let ((runner (make-runner))) (headline "test session starts" bold) @@ -273,7 +295,8 @@ object instead of the list element." ;; Print file, line number and test name. (subheadline (string-append (if file - (string-append file ":") + (string-append (maybe-make-path-relative file) + ":") "") (if line (string-append (number->string line) ":") |