From 397bc485d4985b284c3302027c2d9e82353162b7 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 14 Oct 2015 10:44:00 -0400 Subject: utils: Clean up and add tests. * haunt/utils.scm (flat-map, string-split-at): Add docstring. (file-name-components): Adjust slightly to handle "/". (join-file-name-components): Use prefix string join grammar. (absolute-file-name): Add docstring. * test-env.in: New file. * tests/utils.scm: New file. * Makefile.am (TESTS, TEST_EXTENSIONS, SCM_LOG_COMPILER, AM_SCM_LOG_FLAGS): New variables. * configure.ac: Add test-env pre-processed file. * build-aux/test-driver: New file. --- .gitignore | 6 +- Makefile.am | 7 +++ build-aux/test-driver | 148 ++++++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 1 + haunt/utils.scm | 22 ++++++-- test-env.in | 23 ++++++++ tests/utils.scm | 85 +++++++++++++++++++++++++++++ 7 files changed, 287 insertions(+), 5 deletions(-) create mode 100755 build-aux/test-driver create mode 100644 test-env.in create mode 100644 tests/utils.scm 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 . + +# 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 or send patches to +# . + +# 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 <$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 +# +# 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 . + +"@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 +;;; +;;; 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 . + +(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)))) -- cgit v1.2.3