diff --git a/.gitignore b/.gitignore index 0a123e7..63889fb 100644 --- a/.gitignore +++ b/.gitignore @@ -27,6 +27,7 @@ /build-aux/texinfo.tex /config.status /configure +/configure.ac /doc/*.1 /doc/.dirstamp /doc/contributing.*.texi @@ -57,6 +58,7 @@ GPATH GRTAGS GTAGS Makefile +Makefile.am Makefile.in config.cache stamp-h[0-9] diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm deleted file mode 100644 index 0c555ea..0000000 --- a/build-aux/test-driver.scm +++ /dev/null @@ -1,179 +0,0 @@ -;;;; test-driver.scm - Guile test driver for Automake testsuite harness - -(define script-version "2019-01-15.13") ;UTC - -;;; Copyright © 2015, 2016 Mathieu Lirzin -;;; Copyright © 2019 Alex Sassmannshausen -;;; -;;; 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 3 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, see . - -;;;; Commentary: -;;; -;;; This script provides a Guile test driver using the SRFI-64 Scheme API for -;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. -;;; -;;; This script is a lightly modified version of the orignal written by -;;; Matthieu Lirzin. The changes make it suitable for use as part of the -;;; guile-hall infrastructure. -;;; -;;;; Code: - -(use-modules (ice-9 getopt-long) - (ice-9 pretty-print) - (srfi srfi-26) - (srfi srfi-64)) - -(define (show-help) - (display "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}] [--brief={yes|no}}] [--] - TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] -The '--test-name', '--log-file' and '--trs-file' options are mandatory. -")) - -(define %options - '((test-name (value #t)) - (log-file (value #t)) - (trs-file (value #t)) - (color-tests (value #t)) - (expect-failure (value #t)) ;XXX: not implemented yet - (enable-hard-errors (value #t)) ;not implemented in SRFI-64 - (brief (value #t)) - (help (single-char #\h) (value #f)) - (version (single-char #\V) (value #f)))) - -(define (option->boolean options key) - "Return #t if the value associated with KEY in OPTIONS is 'yes'." - (and=> (option-ref options key #f) (cut string=? <> "yes"))) - -(define* (test-display field value #:optional (port (current-output-port)) - #:key pretty?) - "Display 'FIELD: VALUE\n' on PORT." - (if pretty? - (begin - (format port "~A:~%" field) - (pretty-print value port #:per-line-prefix "+ ")) - (format port "~A: ~S~%" field value))) - -(define* (result->string symbol #:key colorize?) - "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." - (let ((result (string-upcase (symbol->string symbol)))) - (if colorize? - (string-append (case symbol - ((pass) "") ;green - ((xfail) "") ;light green - ((skip) "") ;blue - ((fail xpass) "") ;red - ((error) "")) ;magenta - result - "") ;no color - result))) - -(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) - "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the -file name of the current the test. COLOR? specifies whether to use colors, -and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The -current output port is supposed to be redirected to a '.log' file." - - (define (test-on-test-begin-gnu runner) - ;; Procedure called at the start of an individual test case, before the - ;; test expression (and expected value) are evaluated. - (let ((result (cute assq-ref (test-result-alist runner) <>))) - (format #t "test-name: ~A~%" (result 'test-name)) - (format #t "location: ~A~%" - (string-append (result 'source-file) ":" - (number->string (result 'source-line)))) - (test-display "source" (result 'source-form) #:pretty? #t))) - - (define (test-on-test-end-gnu runner) - ;; Procedure called at the end of an individual test case, when the result - ;; of the test is available. - (let* ((results (test-result-alist runner)) - (result? (cut assq <> results)) - (result (cut assq-ref results <>))) - (unless brief? - ;; Display the result of each test case on the console. - (format out-port "~A: ~A - ~A~%" - (result->string (test-result-kind runner) #:colorize? color?) - test-name (test-runner-test-name runner))) - (when (result? 'expected-value) - (test-display "expected-value" (result 'expected-value))) - (when (result? 'expected-error) - (test-display "expected-error" (result 'expected-error) #:pretty? #t)) - (when (result? 'actual-value) - (test-display "actual-value" (result 'actual-value))) - (when (result? 'actual-error) - (test-display "actual-error" (result 'actual-error) #:pretty? #t)) - (format #t "result: ~a~%" (result->string (result 'result-kind))) - (newline) - (format trs-port ":test-result: ~A ~A~%" - (result->string (test-result-kind runner)) - (test-runner-test-name runner)))) - - (define (test-on-group-end-gnu runner) - ;; Procedure called by a 'test-end', including at the end of a test-group. - (let ((fail (or (positive? (test-runner-fail-count runner)) - (positive? (test-runner-xpass-count runner)))) - (skip (or (positive? (test-runner-skip-count runner)) - (positive? (test-runner-xfail-count runner))))) - ;; XXX: The global results need some refinements for XPASS. - (format trs-port ":global-test-result: ~A~%" - (if fail "FAIL" (if skip "SKIP" "PASS"))) - (format trs-port ":recheck: ~A~%" - (if fail "yes" "no")) - (format trs-port ":copy-in-global-log: ~A~%" - (if (or fail skip) "yes" "no")) - (when brief? - ;; Display the global test group result on the console. - (format out-port "~A: ~A~%" - (result->string (if fail 'fail (if skip 'skip 'pass)) - #:colorize? color?) - test-name)) - #f)) - - (let ((runner (test-runner-null))) - (test-runner-on-test-begin! runner test-on-test-begin-gnu) - (test-runner-on-test-end! runner test-on-test-end-gnu) - (test-runner-on-group-end! runner test-on-group-end-gnu) - (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) - runner)) - -;;; -;;; Entry point. -;;; - -(define (main . args) - (let* ((opts (getopt-long (command-line) %options)) - (option (cut option-ref opts <> <>))) - (cond - ((option 'help #f) (show-help)) - ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) - (else - (let ((log (open-file (option 'log-file "") "w0")) - (trs (open-file (option 'trs-file "") "wl")) - (out (duplicate-port (current-output-port) "wl"))) - (redirect-port log (current-output-port)) - (redirect-port log (current-warning-port)) - (redirect-port log (current-error-port)) - (test-with-runner - (test-runner-gnu (option 'test-name #f) - #:color? (option->boolean opts 'color-tests) - #:brief? (option->boolean opts 'brief) - #:out-port out #:trs-port trs) - (load-from-path (option 'test-name #f))) - (close-port log) - (close-port trs) - (close-port out)))) - (exit 0))) diff --git a/hall.scm b/hall.scm index 0ef39e9..90dd71f 100644 --- a/hall.scm +++ b/hall.scm @@ -12,7 +12,6 @@ (dependencies `(("guile-goblins" (goblins) ,guile-goblins) ("guile-ncurses" (ncurses curses) ,guile-ncurses))) - (skip ()) (features ((guix #f) (use-guix-specs-for-dependencies #f) @@ -24,15 +23,11 @@ "bugafriend" ((directory "utils" - ((compiled-scheme-file "registry") - (scheme-file "registry"))) + ((scheme-file "registry"))) (scheme-file "user") (scheme-file "room") (scheme-file "hconfig") - (compiled-scheme-file "hconfig") - (compiled-scheme-file "listener") (scheme-file "listener") - (compiled-scheme-file "ui") (scheme-file "ui"))))) (tests ((directory "tests" ()))) (programs @@ -61,14 +56,4 @@ (infrastructure ((scheme-file "guix") (text-file ".gitignore") - (scheme-file "hall") - (directory - "build-aux" - ((tex-file "texinfo") - (scheme-file "test-driver") - (text-file "missing") - (text-file "install-sh") - (text-file "mdate-sh"))) - (autoconf-file "configure") - (automake-file "Makefile") - (in-file "pre-inst-env"))))) + (scheme-file "hall"))))) diff --git a/pre-inst-env.in b/pre-inst-env.in deleted file mode 100644 index 31c499d..0000000 --- a/pre-inst-env.in +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/sh - -abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" -abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" - -GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" -GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" -export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH - -PATH="$abs_top_builddir/scripts:$PATH" -export PATH - -exec "$@"