summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore6
-rw-r--r--Makefile.am7
-rwxr-xr-xbuild-aux/test-driver148
-rw-r--r--configure.ac1
-rw-r--r--haunt/utils.scm22
-rw-r--r--test-env.in23
-rw-r--r--tests/utils.scm85
7 files changed, 287 insertions, 5 deletions
diff --git a/.gitignore b/.gitignore
index c26f492..3fc4e6b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,7 +2,6 @@ Makefile
Makefile.in
/aclocal.m4
/autom4te.cache/
-/build-aux/
/config.log
/config.status
/configure
@@ -15,3 +14,8 @@ Makefile.in
/scripts/haunt
*.tar.gz
/website/site
+/test-env
+*.log
+*.trs
+/build-aux/install-sh
+/build-aux/missing
diff --git a/Makefile.am b/Makefile.am
index 541d17f..3ddb01f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -69,6 +69,13 @@ SOURCES += \
endif
+TESTS = \
+ tests/utils.scm
+
+TEST_EXTENSIONS = .scm
+SCM_LOG_COMPILER = $(top_builddir)/test-env $(GUILE)
+AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
+
EXTRA_DIST += \
pre-inst-env.in \
README.md \
diff --git a/build-aux/test-driver b/build-aux/test-driver
new file mode 100755
index 0000000..03524ee
--- /dev/null
+++ b/build-aux/test-driver
@@ -0,0 +1,148 @@
+#!/bin/sh
+# test-driver - basic testsuite driver script.
+
+scriptversion=2015-10-14.01; # UTC
+
+# Copyright (C) 2011-2014 Free Software Foundation, Inc.
+#
+# 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, 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, see <http://www.gnu.org/licenses/>.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# This file is maintained in Automake, please report
+# bugs to <bug-automake@gnu.org> or send patches to
+# <automake-patches@gnu.org>.
+
+# Make unconditional expansion of undefined variables an error. This
+# helps a lot in preventing typo-related bugs.
+set -u
+
+usage_error ()
+{
+ echo "$0: $*" >&2
+ print_usage >&2
+ exit 2
+}
+
+print_usage ()
+{
+ cat <<END
+Usage:
+ test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
+ [--expect-failure={yes|no}] [--color-tests={yes|no}]
+ [--enable-hard-errors={yes|no}] [--]
+ TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
+The '--test-name', '--log-file' and '--trs-file' options are mandatory.
+END
+}
+
+test_name= # Used for reporting.
+log_file= # Where to save the output of the test script.
+trs_file= # Where to save the metadata of the test run.
+expect_failure=no
+color_tests=no
+enable_hard_errors=yes
+while test $# -gt 0; do
+ case $1 in
+ --help) print_usage; exit $?;;
+ --version) echo "test-driver $scriptversion"; exit $?;;
+ --test-name) test_name=$2; shift;;
+ --log-file) log_file=$2; shift;;
+ --trs-file) trs_file=$2; shift;;
+ --color-tests) color_tests=$2; shift;;
+ --expect-failure) expect_failure=$2; shift;;
+ --enable-hard-errors) enable_hard_errors=$2; shift;;
+ --) shift; break;;
+ -*) usage_error "invalid option: '$1'";;
+ *) break;;
+ esac
+ shift
+done
+
+missing_opts=
+test x"$test_name" = x && missing_opts="$missing_opts --test-name"
+test x"$log_file" = x && missing_opts="$missing_opts --log-file"
+test x"$trs_file" = x && missing_opts="$missing_opts --trs-file"
+if test x"$missing_opts" != x; then
+ usage_error "the following mandatory options are missing:$missing_opts"
+fi
+
+if test $# -eq 0; then
+ usage_error "missing argument"
+fi
+
+if test $color_tests = yes; then
+ # Keep this in sync with 'lib/am/check.am:$(am__tty_colors)'.
+ red='' # Red.
+ grn='' # Green.
+ lgn='' # Light green.
+ blu='' # Blue.
+ mgn='' # Magenta.
+ std='' # No color.
+else
+ red= grn= lgn= blu= mgn= std=
+fi
+
+do_exit='rm -f $log_file $trs_file; (exit $st); exit $st'
+trap "st=129; $do_exit" 1
+trap "st=130; $do_exit" 2
+trap "st=141; $do_exit" 13
+trap "st=143; $do_exit" 15
+
+# Test script is run here.
+"$@" >$log_file 2>&1
+estatus=$?
+
+if test $enable_hard_errors = no && test $estatus -eq 99; then
+ tweaked_estatus=1
+else
+ tweaked_estatus=$estatus
+fi
+
+case $tweaked_estatus:$expect_failure in
+ 0:yes) col=$red res=XPASS recheck=yes gcopy=yes;;
+ 0:*) col=$grn res=PASS recheck=no gcopy=no;;
+ 77:*) col=$blu res=SKIP recheck=no gcopy=yes;;
+ 99:*) col=$mgn res=ERROR recheck=yes gcopy=yes;;
+ *:yes) col=$lgn res=XFAIL recheck=no gcopy=yes;;
+ *:*) col=$red res=FAIL recheck=yes gcopy=yes;;
+esac
+
+# Report the test outcome and exit status in the logs, so that one can
+# know whether the test passed or failed simply by looking at the '.log'
+# file, without the need of also peaking into the corresponding '.trs'
+# file (automake bug#11814).
+echo "$res $test_name (exit status: $estatus)" >>$log_file
+
+# Report outcome to console.
+echo "${col}${res}${std}: $test_name"
+
+# Register the test result, and other relevant metadata.
+echo ":test-result: $res" > $trs_file
+echo ":global-test-result: $res" >> $trs_file
+echo ":recheck: $recheck" >> $trs_file
+echo ":copy-in-global-log: $gcopy" >> $trs_file
+
+# Local Variables:
+# mode: shell-script
+# sh-indentation: 2
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/configure.ac b/configure.ac
index c623045..bbd6371 100644
--- a/configure.ac
+++ b/configure.ac
@@ -8,6 +8,7 @@ AM_SILENT_RULES([yes])
AC_CONFIG_FILES([Makefile example/Makefile website/Makefile haunt/config.scm])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+AC_CONFIG_FILES([test-env], [chmod +x test-env])
AC_CONFIG_FILES([scripts/haunt], [chmod +x scripts/haunt])
GUILE_PROGS([2.0.11])
diff --git a/haunt/utils.scm b/haunt/utils.scm
index 29e6ef2..764d6cb 100644
--- a/haunt/utils.scm
+++ b/haunt/utils.scm
@@ -57,9 +57,18 @@ flattened."
lst)))
(define (flat-map proc . lsts)
+ "Apply PROC to each element of each list in LSTS and return a new
+list in which nested lists are concatenated into the result.
+
+For example, the list (1 2 (3)) would be flattened to (1 2 3)."
(flatten (apply map proc lsts) 1))
(define (string-split-at str char-pred)
+ "Split STR at the first character that matches CHAR-PRED and return
+a list of one or two strings. Two strings are returned if the string
+was able to be split, with the character matching CHAR-PRED removed.
+A list containing only STR is returned if CHAR-PRED does not match any
+charcter."
(let ((i (string-index str char-pred)))
(if i
(list (string-take str i)
@@ -68,15 +77,20 @@ flattened."
(define (file-name-components file-name)
"Split FILE-NAME into the components delimited by '/'."
- (if (string-null? file-name)
- '()
- (string-split file-name #\/)))
+ (match file-name
+ ("" '())
+ ("/" '(""))
+ (_ (remove string-null? (string-split file-name #\/)))))
(define (join-file-name-components components)
"Join COMPONENTS into a file name string."
- (string-join components "/"))
+ (string-join components "/" 'prefix))
(define (absolute-file-name file-name)
+ "Return a an absolute file name string relative to the current
+working directory for FILE-NAME, a relative file name string. If
+FILE-NAME happens to already be absolute, FILE-NAME is returned
+as-is."
(if (absolute-file-name? file-name)
file-name
(string-append (getcwd) "/" file-name)))
diff --git a/test-env.in b/test-env.in
new file mode 100644
index 0000000..2eba8af
--- /dev/null
+++ b/test-env.in
@@ -0,0 +1,23 @@
+#!/bin/sh
+
+# Haunt --- Static site generator for GNU Guile
+# Copyright © 2015 David Thompson <davet@gnu.org>
+#
+# This file is part of Haunt.
+#
+# Haunt 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 3 of the License, or
+# (at your option) any later version.
+#
+# Haunt 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 Haunt. If not, see <http://www.gnu.org/licenses/>.
+
+"@abs_top_builddir@/pre-inst-env" "$@"
+
+exit $?
diff --git a/tests/utils.scm b/tests/utils.scm
new file mode 100644
index 0000000..9816769
--- /dev/null
+++ b/tests/utils.scm
@@ -0,0 +1,85 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; This file is part of Haunt.
+;;;
+;;; Haunt 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 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Haunt 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 Haunt. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-utils)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-64)
+ #:use-module (haunt utils))
+
+(test-begin "utils")
+
+(test-equal "flatten, all"
+ '(1 2 3 4 5 6)
+ (flatten '(1 (2 3 (4) (5 (6))))))
+
+(test-equal "flatten, limited depth"
+ '(1 2 3 4 5 (6))
+ (flatten '(1 (2 3 (4) (5 (6)))) 2))
+
+(test-equal "flat-map"
+ '(5 7 9)
+ (flat-map (compose list +) '(1 2 3) '(4 5 6)))
+
+(test-equal "string-split-at, no match"
+ '("foo")
+ (string-split-at "foo" #\z))
+
+(test-equal "string-split-at, match"
+ '("foo" "bar")
+ (string-split-at "foo/bar" #\/))
+
+(test-equal "file-name-components, empty string"
+ '()
+ (file-name-components ""))
+
+(test-equal "file-name-components, root directory"
+ '("")
+ (file-name-components "/"))
+
+(test-equal "file-name-components, full file name"
+ '("share" "haunt")
+ (file-name-components "/share/haunt"))
+
+(test-equal "join-file-name-components"
+ "/share/haunt/info/haunt.info"
+ (join-file-name-components '("share" "haunt" "info" "haunt.info")))
+
+(test-equal "absolute-file-name, already absolute"
+ "/share/haunt"
+ (absolute-file-name "/share/haunt"))
+
+(test-equal "absolute-file-name, relative file name"
+ (string-append (getcwd) "/share/haunt")
+ (absolute-file-name "share/haunt"))
+
+(test-equal "take-up-to, less than n elements"
+ '(1 2 3)
+ (take-up-to 4 '(1 2 3)))
+
+(test-equal "take-up-to, more than n elements"
+ '(1 2)
+ (take-up-to 2 '(1 2 3)))
+
+(test-equal "string->date*"
+ (make-date 0 0 15 06 05 09 2015 (date-zone-offset (current-date)))
+ (string->date* "2015-09-05 06:15"))
+
+(test-end)
+
+
+(exit (zero? (test-runner-fail-count (test-runner-current))))