Make driver.scm into a Guile module.

* src/guile/myra-test-utils/driver.scm (Comments): Add SPDX license identifier.
(define-module): Define (myra-test-utils driver), use #:select or #:prefix on
every import, export `run-test-driver`.
(script-version): Move below `define-module`.
(test-runner-gnu, test-match-name*, test-match-name*/negated, main): Prepend
prefixes to imported srfi 19 and 64 names.
(main): Rename procedure to `run-test-driver` and make it accept a list of
command line arguments as its first argument.

1 files changed, 45 insertions, 41 deletions

diff --git a/src/guile/myra-test-utils/driver.scm b/src/guile/myra-test-utils/driver.scm
index 1cdd4ff..bfb5a1f 100755
--- a/src/guile/myra-test-utils/driver.scm
+++ b/src/guile/myra-test-utils/driver.scm
@@ -1,12 +1,10 @@
-#!/bin/sh
-exec guile --no-auto-compile -e main -s "$0" "$@"
-!#
-;;;; test-driver.scm - Guile test driver for Automake testsuite harness
+;;; SPDX-License-Identifier: GPL-3.0-or-later AND CC0-1.0
 
-(define script-version "2021-02-02.05") ;UTC
+;;;; driver.scm - Guile test driver for Automake testsuite harness
 
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2023 Wojtek Kosior <my-contribution-is-licensed-cc0@koszko.org>
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify it
 ;;; under the terms of the GNU General Public License as published by
@@ -28,14 +26,18 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
 ;;;
 ;;;; Code:
 
-(use-modules (ice-9 format)
-             (ice-9 getopt-long)
-             (ice-9 pretty-print)
-             (ice-9 regex)
-             (srfi srfi-1)
-             (srfi srfi-19)
-             (srfi srfi-26)
-             (srfi srfi-64))
+(define-module (myra-test-utils driver)
+  #: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 ((srfi srfi-1) #:select (filter-map))
+  #:use-module ((srfi srfi-19) #:prefix s19:)
+  #:use-module ((srfi srfi-26) #:select (cut))
+  #:use-module ((srfi srfi-64) #:prefix s64:)
+  #:export (run-test-driver))
+
+(define script-version "2023-12-06.16") ;UTC
 
 (define (show-help)
   (display "Usage:
@@ -120,33 +122,35 @@ cases based on their names."
   (define (test-on-test-begin-gnu runner)
     ;; Procedure called at the start of an individual test case, before the
     ;; test expression (and expected value) are evaluated.
-    (let ((test-case-name (test-runner-test-name runner))
-          (start-time     (current-time time-monotonic)))
+    (let ((test-case-name (s64:test-runner-test-name runner))
+          (start-time     (s19:current-time s19:time-monotonic)))
       (hash-set! test-cases-start-time test-case-name start-time)))
 
   (define (test-skipped? runner)
-    (eq? 'skip (test-result-kind runner)))
+    (eq? 'skip (s64:test-result-kind runner)))
 
   (define (test-failed? runner)
-    (not (or (test-passed? runner)
+    (not (or (s64:test-passed? runner)
              (test-skipped? runner))))
 
   (define (test-on-test-end-gnu runner)
     ;; Procedure called at the end of an individual test case, when the result
     ;; of the test is available.
-    (let* ((results (test-result-alist runner))
+    (let* ((results (s64:test-result-alist runner))
            (result? (cut assq <> results))
            (result  (cut assq-ref results <>))
-           (test-case-name (test-runner-test-name runner))
+           (test-case-name (s64:test-runner-test-name runner))
            (start (hash-ref test-cases-start-time test-case-name))
-           (end (current-time time-monotonic))
-           (time-elapsed (time-difference end start))
-           (time-elapsed-seconds (+ (time-second time-elapsed)
-                                    (* 1e-9 (time-nanosecond time-elapsed)))))
+           (end (s19:current-time s19:time-monotonic))
+           (time-elapsed (s19:time-difference end start))
+           (time-elapsed-seconds (+ (s19:time-second time-elapsed)
+                                    (* 1e-9 (s19:time-nanosecond
+                                             time-elapsed)))))
       (unless (or brief? (and errors-only? (test-skipped? runner)))
         ;; Display the result of each test case on the console.
         (format out-port "~a: ~a - ~a ~@[[~,3fs]~]~%"
-                (result->string (test-result-kind runner) #:colorize? color?)
+                (result->string (s64:test-result-kind runner)
+                                #:colorize? color?)
                 test-name test-case-name
                 (and show-duration? time-elapsed-seconds)))
 
@@ -168,15 +172,15 @@ cases based on their names."
         (newline))
 
       (format trs-port ":test-result: ~A ~A [~,3fs]~%"
-              (result->string (test-result-kind runner))
-              (test-runner-test-name runner) time-elapsed-seconds)))
+              (result->string (s64:test-result-kind runner))
+              (s64:test-runner-test-name runner) time-elapsed-seconds)))
 
   (define (test-on-group-end-gnu runner)
     ;; Procedure called by a 'test-end', including at the end of a test-group.
-    (let ((fail (or (positive? (test-runner-fail-count runner))
-                    (positive? (test-runner-xpass-count runner))))
-          (skip (or (positive? (test-runner-skip-count runner))
-                    (positive? (test-runner-xfail-count runner)))))
+    (let ((fail (or (positive? (s64:test-runner-fail-count runner))
+                    (positive? (s64:test-runner-xpass-count runner))))
+          (skip (or (positive? (s64:test-runner-skip-count runner))
+                    (positive? (s64:test-runner-xfail-count runner)))))
       ;; XXX: The global results need some refinements for XPASS.
       (format trs-port ":global-test-result: ~A~%"
               (if fail "FAIL" (if skip "SKIP" "PASS")))
@@ -192,11 +196,11 @@ cases based on their names."
                 test-name))
       #f))
 
-  (let ((runner (test-runner-null)))
-    (test-runner-on-test-begin! runner test-on-test-begin-gnu)
-    (test-runner-on-test-end! runner test-on-test-end-gnu)
-    (test-runner-on-group-end! runner test-on-group-end-gnu)
-    (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
+  (let ((runner (s64:test-runner-null)))
+    (s64:test-runner-on-test-begin! runner test-on-test-begin-gnu)
+    (s64:test-runner-on-test-end! runner test-on-test-end-gnu)
+    (s64:test-runner-on-group-end! runner test-on-group-end-gnu)
+    (s64:test-runner-on-bad-end-name! runner s64:test-on-bad-end-name-simple)
     runner))
 
 
@@ -206,12 +210,12 @@ cases based on their names."
 (define (test-match-name* regexp)
   "Return a test specifier that matches a test name against REGEXP."
   (lambda (runner)
-    (string-match regexp (test-runner-test-name runner))))
+    (string-match regexp (s64:test-runner-test-name runner))))
 
 (define (test-match-name*/negated regexp)
   "Return a negated test specifier version of test-match-name*."
   (lambda (runner)
-    (not (string-match regexp (test-runner-test-name runner)))))
+    (not (string-match regexp (s64:test-runner-test-name runner)))))
 
 ;;; XXX: test-match-all is a syntax, which isn't convenient to use with a list
 ;;; of test specifiers computed at run time.  Copy this SRFI 64 internal
@@ -232,8 +236,8 @@ cases based on their names."
 ;;; Entry point.
 ;;;
 
-(define (main . args)
-  (let* ((opts   (getopt-long (command-line) %options))
+(define (run-test-driver args)
+  (let* ((opts   (getopt-long args %options))
          (option (cut option-ref opts <> <>)))
     (cond
      ((option 'help #f)    (show-help))
@@ -257,7 +261,7 @@ cases based on their names."
           (redirect-port log (current-output-port))
           (redirect-port log (current-warning-port))
           (redirect-port log (current-error-port)))
-        (test-with-runner
+        (s64:test-with-runner
             (test-runner-gnu test-name
                              #:color? color-tests
                              #:brief? (option->boolean opts 'brief)
@@ -265,7 +269,7 @@ cases based on their names."
                              #:show-duration? (option->boolean
                                                opts 'show-duration)
                              #:out-port out #:trs-port trs)
-          (test-apply test-specifier
+          (s64:test-apply test-specifier
                       (lambda _
                         (load-from-path test-name))))
         (and=> log close-port)