diff options
Diffstat (limited to 'build-aux')
| -rwxr-xr-x | build-aux/gitlog-to-changelog | 33 | ||||
| -rw-r--r-- | build-aux/test-driver.scm | 124 |
2 files changed, 92 insertions, 65 deletions
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index 8f38318..1e73f42 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -1,15 +1,15 @@ -eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}' +eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"' & eval 'exec perl -wS "$0" $argv:q' if 0; # Convert git log output to ChangeLog format. -my $VERSION = '2015-07-21 22:45'; # UTC +my $VERSION = '2018-03-07 03:47'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook # do its job. Otherwise, update this string manually. -# Copyright (C) 2008-2015 Free Software Foundation, Inc. +# Copyright (C) 2008-2018 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 @@ -22,7 +22,7 @@ my $VERSION = '2015-07-21 22:45'; # UTC # 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/>. +# along with this program. If not, see <https://www.gnu.org/licenses/>. # Written by Jim Meyering @@ -33,7 +33,7 @@ use POSIX qw(strftime); (my $ME = $0) =~ s|.*/||; -# use File::Coda; # http://meyering.net/code/Coda/ +# use File::Coda; # https://meyering.net/code/Coda/ END { defined fileno STDOUT or return; close STDOUT and return; @@ -298,9 +298,7 @@ sub git_dir_option($) { if ($sha =~ /^$_/) { - $skipflag = 1; - ## Perhaps only warn if a pattern matches more than once? - warn "$ME: warning: skipping $sha due to $_\n"; + $skipflag = $_; last; } } @@ -333,7 +331,7 @@ sub git_dir_option($) $rest =~ s/^\s*\(cherry picked from commit [\da-f]+\)\n//m; } - my @line = split /\s*\n/, $rest; + my @line = split /[ \t]*\n/, $rest; my $author_line = shift @line; defined $author_line or die "$ME:$.: unexpected EOF\n"; @@ -386,8 +384,17 @@ sub git_dir_option($) } # Ignore commits that match the --ignore-matching pattern, if specified. - if (! ($skipflag || (defined $ignore_matching - && @line && $line[0] =~ /$ignore_matching/))) + if (defined $ignore_matching && @line && $line[0] =~ /$ignore_matching/) + { + $skipflag = 1; + } + elsif ($skipflag) + { + ## Perhaps only warn if a pattern matches more than once? + warn "$ME: warning: skipping $sha due to $skipflag\n"; + } + + if (! $skipflag) { if (defined $ignore_line && @line) { @@ -484,9 +491,9 @@ sub git_dir_option($) # Local Variables: # mode: perl # indent-tabs-mode: nil -# eval: (add-hook 'write-file-hooks 'time-stamp) +# eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "my $VERSION = '" # time-stamp-format: "%:y-%02m-%02d %02H:%02M" -# time-stamp-time-zone: "UTC" +# time-stamp-time-zone: "UTC0" # time-stamp-end: "'; # UTC" # End: diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm index 01edf93..5292c0a 100644 --- a/build-aux/test-driver.scm +++ b/build-aux/test-driver.scm @@ -1,8 +1,8 @@ ;;;; test-driver.scm - Guile test driver for Automake testsuite harness -(define script-version "2016-05-09.22") ;UTC +(define script-version "2018-03-24.22") ;UTC -;;; Copyright (C) 2015, 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2015-2018 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 @@ -16,20 +16,40 @@ ;;; ;;; 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. ;;;; 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. ;;; +;;; To use it, you have to manually copy this file in the ‘build-aux’ +;;; directory of your package, then adapt the following snippets to your +;;; actual needs: +;;; +;;; configure.ac: +;;; AC_CONFIG_AUX_DIR([build-aux]) +;;; AC_REQUIRE_AUX_FILE([test-driver.scm]) +;;; AC_PATH_PROG([GUILE], [guile]) +;;; +;;; Makefile.am +;;; TEST_LOG_DRIVER = $(GUILE) $(top_srcdir)/build-aux/test-driver.scm +;;; AM_TESTS_ENVIRONMENT = env GUILE_AUTO_COMPILE='0' +;;; TESTS = foo.test +;;; EXTRA_DIST = $(TESTS) +;;; +;;; foo.test +;;; (use-modules (srfi srfi-64)) +;;; (test-begin "foo") +;;; (test-assert "assertion example" #t) +;;; (test-end "foo") +;;; +;;; See <https://srfi.schemers.org/srfi-64/srfi-64.html> for general +;;; information about SRFI-64 usage. +;;; ;;;; Code: (use-modules (ice-9 getopt-long) + (ice-9 match) (ice-9 pretty-print) (srfi srfi-26) (srfi srfi-64)) @@ -64,7 +84,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) (begin (format port "~A:~%" field) (pretty-print value port #:per-line-prefix "+ ")) - (format port "~A: ~A~%" field value))) + (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." @@ -90,10 +110,10 @@ current output port is supposed to be redirected to a '.log' file." ;; 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) <>))) - (test-display "test-name" (result 'test-name)) - (test-display "location" - (string-append (result 'source-file) ":" - (number->string (result 'source-line)))) + (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) @@ -104,10 +124,9 @@ current output port is supposed to be redirected to a '.log' file." (result (cut assq-ref results <>))) (unless brief? ;; Display the result of each test case on the console. - (test-display - (result->string (test-result-kind runner) #:colorize? color?) - (string-append test-name " - " (test-runner-test-name runner)) - out-port)) + (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) @@ -116,12 +135,11 @@ current output port is supposed to be redirected to a '.log' file." (test-display "actual-value" (result 'actual-value))) (when (result? 'actual-error) (test-display "actual-error" (result 'actual-error) #:pretty? #t)) - (test-display "result" (result->string (result 'result-kind))) + (format #t "result: ~a~%" (result->string (result 'result-kind))) (newline) - (test-display ":test-result" - (string-append (result->string (test-result-kind runner)) - " " (test-runner-test-name runner)) - trs-port))) + (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. @@ -130,21 +148,18 @@ current output port is supposed to be redirected to a '.log' file." (skip (or (positive? (test-runner-skip-count runner)) (positive? (test-runner-xfail-count runner))))) ;; XXX: The global results need some refinements for XPASS. - (test-display ":global-test-result" - (if fail "FAIL" (if skip "SKIP" "PASS")) - trs-port) - (test-display ":recheck" - (if fail "yes" "no") - trs-port) - (test-display ":copy-in-global-log" - (if (or fail skip) "yes" "no") - trs-port) + (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. - (test-display (result->string (if fail 'fail (if skip 'skip 'pass)) - #:colorize? color?) - test-name - out-port)) + (format out-port "~A: ~A~%" + (result->string (if fail 'fail (if skip 'skip 'pass)) + #:colorize? color?) + test-name)) #f)) (let ((runner (test-runner-null))) @@ -163,30 +178,35 @@ current output port is supposed to be redirected to a '.log' file." (option (cut option-ref opts <> <>))) (cond ((option 'help #f) (show-help)) - ((option 'version #f) (format #t "test-driver.scm ~A~%" script-version)) + ((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 (string-append (getcwd) "/" (car (option '() '("")))))) - (close-port log) - (close-port trs) - (close-port out)))) + (match (option '() '()) + (() + (display "missing test script argument\n" (current-error-port)) + (exit 1)) + ((script . args) + (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) + (primitive-load script)) + (close-port log) + (close-port trs) + (close-port out)))))) (exit 0)) ;;; Local Variables: -;;; eval: (add-hook 'write-file-functions 'time-stamp) +;;; eval: (add-hook 'before-save-hook 'time-stamp) ;;; time-stamp-start: "(define script-version \"" ;;; time-stamp-format: "%:y-%02m-%02d.%02H" -;;; time-stamp-time-zone: "UTC" +;;; time-stamp-time-zone: "UTC0" ;;; time-stamp-end: "\") ;UTC" ;;; End: |