diff options
| -rw-r--r-- | .gitignore | 5 | ||||
| -rw-r--r-- | Makefile.am | 17 | ||||
| -rw-r--r-- | build-aux/test-driver.scm.in | 100 | ||||
| -rw-r--r-- | configure.ac | 1 | ||||
| -rw-r--r-- | tests/xapian.scm | 25 |
5 files changed, 147 insertions, 1 deletions
diff --git a/.gitignore b/.gitignore index 0432bfc..7c9bd76 100644 --- a/.gitignore +++ b/.gitignore @@ -21,8 +21,13 @@ xapian/*.go xapian/wrap.scm xapian_wrap.cc +# tests +tests/*.log +tests/*.trs + # website website/index.html # other +build-aux/test-driver.scm pre-inst-env \ No newline at end of file diff --git a/Makefile.am b/Makefile.am index b5f954f..6417ce9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -54,7 +54,7 @@ nobase_mod_DATA = $(SOURCES) nobase_go_DATA = $(GOBJECTS) CLEANFILES = $(GOBJECTS) -EXTRA_DIST = $(SOURCES) + GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat SUFFIXES = .scm .go .scm.go: @@ -64,6 +64,21 @@ SUFFIXES = .scm .go # shared library. xapian/xapian.go: xapian/xapian.scm libguilexapian.la +# Tests + +TEST_EXTENSIONS = .scm +SCM_TESTS = tests/xapian.scm +TESTS = $(SCM_TESTS) + +SCM_LOG_DRIVER = \ + $(builddir)/pre-inst-env \ + $(GUILE) --no-auto-compile -s \ + $(builddir)/build-aux/test-driver.scm + +# Distribution + +EXTRA_DIST = $(TESTS) $(SOURCES) + # Build website website: website/index.html diff --git a/build-aux/test-driver.scm.in b/build-aux/test-driver.scm.in new file mode 100644 index 0000000..262d3a8 --- /dev/null +++ b/build-aux/test-driver.scm.in @@ -0,0 +1,100 @@ +;;; guile-xapian --- Guile bindings for Xapian +;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of guile-xapian. +;;; +;;; guile-xapian 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. +;;; +;;; guile-xapian 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 guile-xapian. If not, see +;;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is a better test driver for Guile's (srfi srfi-64). +;; +;; TODO: Improve Guile's test driver so this module won't be +;; necessary. + +;;; Code: + +(use-modules (ice-9 format) + (ice-9 getopt-long) + (ice-9 match) + (srfi srfi-26) + (srfi srfi-64)) + +;; Currently, only log-file and trs-file are understood. Everything +;; else is ignored. +(define %options + '((test-name (value #t)) + (log-file (value #t)) + (trs-file (value #t)) + (color-tests (value #t)) + (expect-failure (value #t)) + (enable-hard-errors (value #t)))) + +(define (color code str color?) + (if color? + (format #f "~a[~am~a~a[0m" #\esc code str #\esc) + str)) + +(define red (cut color 31 <> <>)) +(define green (cut color 32 <> <>)) +(define magenta (cut color 35 <> <>)) + +(define (my-gnu-runner log-port trs-port color?) + (let ((runner (test-runner-null))) + (test-runner-on-group-begin! runner + (lambda (runner suite-name count) + (format #t (magenta "%%%% ~a~%" color?) suite-name))) + (test-runner-on-group-end! runner + (lambda _ + (newline))) + (test-runner-on-test-end! runner + (lambda (runner) + (let ((name (test-runner-test-name runner)) + (result (string-upcase + (symbol->string (test-result-kind runner)))) + (result-alist (test-result-alist runner))) + (format trs-port ":test-result: ~a ~a~%" result name) + (format #t "~a ~a~%" + (case (test-result-kind runner) + ((pass) (green result color?)) + (else (red result color?))) + name) + (format log-port "~a ~a~%" result name) + ;; If test did not pass, print details. + (unless (eq? (test-result-kind runner) 'pass) + (let* ((expected-value (match (assq-ref result-alist 'source-form) + (('test-assert _ ...) #t) + (_ (assq-ref result-alist 'expected-value)))) + (log-output + (format #f "~a:~a~%expected: ~s~%actual: ~s~%" + (assq-ref result-alist 'source-file) + (assq-ref result-alist 'source-line) + expected-value + (assq-ref result-alist 'actual-value)))) + (display log-output log-port) + (display log-output (current-error-port))))))) + runner)) + +(let ((opts (getopt-long (command-line) %options))) + (call-with-output-file (string-append "@abs_top_builddir@/" + (option-ref opts 'log-file #f)) + (lambda (log-port) + (call-with-output-file (option-ref opts 'trs-file #f) + (lambda (trs-port) + (chdir "@abs_top_srcdir@") + (test-with-runner (my-gnu-runner log-port trs-port + (string=? (option-ref opts 'color-tests "yes") + "yes")) + (load-from-path (option-ref opts 'test-name #f)))))))) diff --git a/configure.ac b/configure.ac index ad713be..2a261f1 100644 --- a/configure.ac +++ b/configure.ac @@ -44,4 +44,5 @@ AC_SUBST([SWIG_FLAGS], [$(PKG_CONFIG_ALLOW_SYSTEM_CFLAGS=1 pkg-config --cflags x AC_CONFIG_FILES([Makefile]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) +AC_CONFIG_FILES([build-aux/test-driver.scm]) AC_OUTPUT diff --git a/tests/xapian.scm b/tests/xapian.scm new file mode 100644 index 0000000..fd339e1 --- /dev/null +++ b/tests/xapian.scm @@ -0,0 +1,25 @@ +;;; guile-xapian --- Guile bindings for Xapian +;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of guile-xapian. +;;; +;;; guile-xapian 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. +;;; +;;; guile-xapian 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 guile-xapian. If not, see +;;; <https://www.gnu.org/licenses/>. + +(use-modules (srfi srfi-64) + (xapian xapian)) + +(test-begin "xapian") + +(test-end "xapian") |