From c6032ac6ed52f44b112dee4c5cf0ed9d261a437e Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 6 May 2018 20:43:32 +0800 Subject: [PATCH] srfi64-extras.scm: centralize (gnc:test-runner) This is good enough to be used widely. --- .../test/test-html-utilities-srfi64.scm | 30 +----------- .../test/test-transaction.scm | 30 +----------- libgnucash/engine/test/CMakeLists.txt | 15 ++++++ libgnucash/engine/test/srfi64-extras.scm | 49 +++++++++++++++++++ 4 files changed, 68 insertions(+), 56 deletions(-) create mode 100644 libgnucash/engine/test/srfi64-extras.scm diff --git a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm b/gnucash/report/report-system/test/test-html-utilities-srfi64.scm index 5c46793264..ef712c7acb 100644 --- a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm +++ b/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")) diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm index 29e8e48e5f..1dfa2fd973 100644 --- a/gnucash/report/standard-reports/test/test-transaction.scm +++ b/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) diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt index 587c0eb1c8..7d698f5f83 100644 --- a/libgnucash/engine/test/CMakeLists.txt +++ b/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}) diff --git a/libgnucash/engine/test/srfi64-extras.scm b/libgnucash/engine/test/srfi64-extras.scm new file mode 100644 index 0000000000..81329b219f --- /dev/null +++ b/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))