srfi64-extras.scm: centralize (gnc:test-runner)

This is good enough to be used widely.

gnucash/report/report-system/test/test-html-utilities-srfi64.scm

@@ -6,37 +6,11 @@
 (use-modules (gnucash engine test test-extras))
 (use-modules (gnucash report report-system test test-extras))
 (use-modules (gnucash report report-system))
+(use-modules (gnucash engine test srfi64-extras))
 (use-modules (srfi srfi-64))
 
-(define (test-runner)
-  (let ((runner (test-runner-null))
-        (num-passed 0)
-        (num-failed 0))
-    (test-runner-on-test-end! runner
-      (lambda (runner)
-        (format #t "[~a] line:~a, test: ~a\n"
-                (test-result-ref runner 'result-kind)
-                (test-result-ref runner 'source-line)
-                (test-runner-test-name runner))
-        (case (test-result-kind runner)
-          ((pass xpass) (set! num-passed (1+ num-passed)))
-          ((fail xfail)
-           (if (test-result-ref runner 'expected-value)
-               (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
-                       (string-join (test-runner-group-path runner) "/")
-                       (test-result-ref runner 'expected-value)
-                       (test-result-ref runner 'actual-value)))
-           (set! num-failed (1+ num-failed)))
-          (else #t))))
-    (test-runner-on-final! runner
-      (lambda (runner)
-        (format #t "Source:~a\npass = ~a, fail = ~a\n"
-                (test-result-ref runner 'source-file) num-passed num-failed)
-        (zero? num-failed)))
-    runner))
-
 (define (run-test)
-  (test-runner-factory test-runner)
+  (test-runner-factory gnc:test-runner)
   (test-begin "test-html-utilities-srfi64.scm")
   (test-gnc:html-string-sanitize)
   (test-end "test-html-utilities-srfi64.scm"))

gnucash/report/standard-reports/test/test-transaction.scm

@@ -6,6 +6,7 @@
 (use-modules (gnucash report report-system))
 (use-modules (gnucash report report-system test test-extras))
 (use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
 (use-modules (sxml simple))
 (use-modules (sxml xpath))
 (use-modules (system vm coverage))
@@ -42,33 +43,6 @@
 ;; Explicitly set locale to make the report output predictable
 (setlocale LC_ALL "C")
 
-(define (test-runner)
-  (let ((runner (test-runner-null))
-        (num-passed 0)
-        (num-failed 0))
-    (test-runner-on-test-end! runner
-      (lambda (runner)
-        (format #t "[~a] line:~a, test: ~a\n"
-                (test-result-ref runner 'result-kind)
-                (test-result-ref runner 'source-line)
-                (test-runner-test-name runner))
-        (case (test-result-kind runner)
-          ((pass xpass) (set! num-passed (1+ num-passed)))
-          ((fail xfail)
-           (if (test-result-ref runner 'expected-value)
-               (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
-                       (string-join (test-runner-group-path runner) "/")
-                       (test-result-ref runner 'expected-value)
-                       (test-result-ref runner 'actual-value)))
-           (set! num-failed (1+ num-failed)))
-          (else #t))))
-    (test-runner-on-final! runner
-      (lambda (runner)
-        (format #t "Source:~a\npass = ~a, fail = ~a\n"
-                (test-result-ref runner 'source-file) num-passed num-failed)
-        (zero? num-failed)))
-    runner))
-
 (define (run-test)
   (if #f
       (coverage-test)
@@ -86,7 +60,7 @@
         (close port)))))
 
 (define (run-test-proper)
-  (test-runner-factory test-runner)
+  (test-runner-factory gnc:test-runner)
   (test-begin "transaction.scm")
   (null-test)
   (trep-tests)

libgnucash/engine/test/CMakeLists.txt

@@ -233,6 +233,20 @@ gnc_add_scheme_targets(scm-test-engine-extras
   FALSE
   )
 
+if (HAVE_SRFI64)
+  gnc_add_scheme_targets (scm-srfi64-extras
+    "srfi64-extras.scm"
+    "gnucash/engine/test/"
+    "${GUILE_DEPENDS}"
+    FALSE
+    )
+
+  set(srfi64_extras_SCHEME_DIST
+    srfi64-extras.scm
+    )
+
+endif (HAVE_SRFI64)
+
 gnc_add_scheme_targets(scm-test-engine
   "${engine_test_SCHEME}"
   ""
@@ -311,4 +325,5 @@ set(test_engine_EXTRA_DIST
 )
 
 set_dist_list(test_engine_DIST CMakeLists.txt
+        ${srfi64_extras_SCHEME_DIST}
         ${test_engine_SOURCES_DIST} ${test_engine_SCHEME_DIST} ${test_engine_EXTRA_DIST})

libgnucash/engine/test/srfi64-extras.scm

@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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 the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation           Voice:  +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
+;; Boston, MA  02110-1301,  USA       gnu@gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (gnucash engine test srfi64-extras))
+(use-modules (srfi srfi-64))
+
+(export gnc:test-runner)
+(define (gnc:test-runner)
+  (let ((runner (test-runner-null))
+        (num-passed 0)
+        (num-failed 0))
+    (test-runner-on-test-end! runner
+      (lambda (runner)
+        (format #t "[~a] line:~a, test: ~a\n"
+                (test-result-ref runner 'result-kind)
+                (test-result-ref runner 'source-line)
+                (test-runner-test-name runner))
+        (case (test-result-kind runner)
+          ((pass xpass) (set! num-passed (1+ num-passed)))
+          ((fail xfail)
+           (if (test-result-ref runner 'expected-value)
+               (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
+                       (string-join (test-runner-group-path runner) "/")
+                       (test-result-ref runner 'expected-value)
+                       (test-result-ref runner 'actual-value)))
+           (set! num-failed (1+ num-failed)))
+          (else #t))))
+    (test-runner-on-final! runner
+      (lambda (runner)
+        (format #t "Source:~a\npass = ~a, fail = ~a\n"
+                (test-result-ref runner 'source-file) num-passed num-failed)
+        (zero? num-failed)))
+    runner))