dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

maint: Update files from upstream with "build-aux/gnu-fetch"

Browse source 
* build-aux/gitlog-to-changelog: Update.
* build-aux/test-driver.scm: Likewise.
This commit is contained in:
Mathieu Lirzin 2018-03-24 22:09:15 +01:00
commit 2169f4a7b3
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
2 changed files with 92 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

33
build-aux/gitlog-to-changelog
View file

@ -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' & eval 'exec perl -wS "$0" $argv:q'
if 0; if 0;
# Convert git log output to ChangeLog format. # 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 # The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it. # for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook # If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually. # 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 # 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 # 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. # GNU General Public License for more details.
# You should have received a copy of the GNU General Public License # 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 # Written by Jim Meyering
@ -33,7 +33,7 @@ use POSIX qw(strftime);
(my $ME = $0) =~ s|.*/||; (my $ME = $0) =~ s|.*/||;
# use File::Coda; # http://meyering.net/code/Coda/ # use File::Coda; # https://meyering.net/code/Coda/
END { END {
defined fileno STDOUT or return; defined fileno STDOUT or return;
close STDOUT and return; close STDOUT and return;
@ -298,9 +298,7 @@ sub git_dir_option($)
{ {
if ($sha =~ /^$_/) if ($sha =~ /^$_/)
{ {
$skipflag = 1; $skipflag = $_;
## Perhaps only warn if a pattern matches more than once?
warn "$ME: warning: skipping $sha due to $_\n";
last; last;
} }
} }
@ -333,7 +331,7 @@ sub git_dir_option($)
$rest =~ s/^\s*\(cherry picked from commit [\da-f]+\)\n//m; $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; my $author_line = shift @line;
defined $author_line defined $author_line
or die "$ME:$.: unexpected EOF\n"; or die "$ME:$.: unexpected EOF\n";
@ -386,8 +384,17 @@ sub git_dir_option($)
} }
# Ignore commits that match the --ignore-matching pattern, if specified. # Ignore commits that match the --ignore-matching pattern, if specified.
if (! ($skipflag || (defined $ignore_matching if (defined $ignore_matching && @line && $line[0] =~ /$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) if (defined $ignore_line && @line)
{ {
@ -484,9 +491,9 @@ sub git_dir_option($)
# Local Variables: # Local Variables:
# mode: perl # mode: perl
# indent-tabs-mode: nil # 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-start: "my $VERSION = '"
# time-stamp-format: "%:y-%02m-%02d %02H:%02M" # time-stamp-format: "%:y-%02m-%02d %02H:%02M"
# time-stamp-time-zone: "UTC" # time-stamp-time-zone: "UTC0"
# time-stamp-end: "'; # UTC" # time-stamp-end: "'; # UTC"
# End: # End:

124
build-aux/test-driver.scm
View file

@ -1,8 +1,8 @@
;;;; test-driver.scm - Guile test driver for Automake testsuite harness ;;;; 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 ;;; 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 ;;; 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 ;;; 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 <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: ;;;; Commentary:
;;; ;;;
;;; This script provides a Guile test driver using the SRFI-64 Scheme API for ;;; 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. ;;; 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: ;;;; Code:
(use-modules (ice-9 getopt-long) (use-modules (ice-9 getopt-long)
(ice-9 match)
(ice-9 pretty-print) (ice-9 pretty-print)
(srfi srfi-26) (srfi srfi-26)
(srfi srfi-64)) (srfi srfi-64))
@ -64,7 +84,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
(begin (begin
(format port "~A:~%" field) (format port "~A:~%" field)
(pretty-print value port #:per-line-prefix "+ ")) (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?) (define* (result->string symbol #:key colorize?)
"Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." "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 ;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated. ;; test expression (and expected value) are evaluated.
(let ((result (cute assq-ref (test-result-alist runner) <>))) (let ((result (cute assq-ref (test-result-alist runner) <>)))
(test-display "test-name" (result 'test-name)) (format #t "test-name: ~A~%" (result 'test-name))
(test-display "location" (format #t "location: ~A~%"
(string-append (result 'source-file) ":" (string-append (result 'source-file) ":"
(number->string (result 'source-line)))) (number->string (result 'source-line))))
(test-display "source" (result 'source-form) #:pretty? #t))) (test-display "source" (result 'source-form) #:pretty? #t)))
(define (test-on-test-end-gnu runner) (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 <>))) (result (cut assq-ref results <>)))
(unless brief? (unless brief?
;; Display the result of each test case on the console. ;; Display the result of each test case on the console.
(test-display (format out-port "~A: ~A - ~A~%"
(result->string (test-result-kind runner) #:colorize? color?) (result->string (test-result-kind runner) #:colorize? color?)
(string-append test-name " - " (test-runner-test-name runner)) test-name (test-runner-test-name runner)))
out-port))
(when (result? 'expected-value) (when (result? 'expected-value)
(test-display "expected-value" (result 'expected-value))) (test-display "expected-value" (result 'expected-value)))
(when (result? 'expected-error) (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))) (test-display "actual-value" (result 'actual-value)))
(when (result? 'actual-error) (when (result? 'actual-error)
(test-display "actual-error" (result 'actual-error) #:pretty? #t)) (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) (newline)
(test-display ":test-result" (format trs-port ":test-result: ~A ~A~%"
(string-append (result->string (test-result-kind runner)) (result->string (test-result-kind runner))
" " (test-runner-test-name runner)) (test-runner-test-name runner))))
trs-port)))
(define (test-on-group-end-gnu runner) (define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group. ;; 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)) (skip (or (positive? (test-runner-skip-count runner))
(positive? (test-runner-xfail-count runner))))) (positive? (test-runner-xfail-count runner)))))
;; XXX: The global results need some refinements for XPASS. ;; XXX: The global results need some refinements for XPASS.
(test-display ":global-test-result" (format trs-port ":global-test-result: ~A~%"
(if fail "FAIL" (if skip "SKIP" "PASS")) (if fail "FAIL" (if skip "SKIP" "PASS")))
trs-port) (format trs-port ":recheck: ~A~%"
(test-display ":recheck" (if fail "yes" "no"))
(if fail "yes" "no") (format trs-port ":copy-in-global-log: ~A~%"
trs-port) (if (or fail skip) "yes" "no"))
(test-display ":copy-in-global-log"
(if (or fail skip) "yes" "no")
trs-port)
(when brief? (when brief?
;; Display the global test group result on the console. ;; Display the global test group result on the console.
(test-display (result->string (if fail 'fail (if skip 'skip 'pass)) (format out-port "~A: ~A~%"
#:colorize? color?) (result->string (if fail 'fail (if skip 'skip 'pass))
test-name #:colorize? color?)
out-port)) test-name))
#f)) #f))
(let ((runner (test-runner-null))) (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 <> <>))) (option (cut option-ref opts <> <>)))
(cond (cond
((option 'help #f) (show-help)) ((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 (else
(let ((log (open-file (option 'log-file "") "w0")) (match (option '() '())
(trs (open-file (option 'trs-file "") "wl")) (()
(out (duplicate-port (current-output-port) "wl"))) (display "missing test script argument\n" (current-error-port))
(redirect-port log (current-output-port)) (exit 1))
(redirect-port log (current-warning-port)) ((script . args)
(redirect-port log (current-error-port)) (let ((log (open-file (option 'log-file "") "w0"))
(test-with-runner (trs (open-file (option 'trs-file "") "wl"))
(test-runner-gnu (option 'test-name #f) (out (duplicate-port (current-output-port) "wl")))
#:color? (option->boolean opts 'color-tests) (redirect-port log (current-output-port))
#:brief? (option->boolean opts 'brief) (redirect-port log (current-warning-port))
#:out-port out #:trs-port trs) (redirect-port log (current-error-port))
(load (string-append (getcwd) "/" (car (option '() '("")))))) (test-with-runner
(close-port log) (test-runner-gnu (option 'test-name #f)
(close-port trs) #:color? (option->boolean opts 'color-tests)
(close-port out)))) #: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)) (exit 0))
;;; Local Variables: ;;; 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-start: "(define script-version \""
;;; time-stamp-format: "%:y-%02m-%02d.%02H" ;;; time-stamp-format: "%:y-%02m-%02d.%02H"
;;; time-stamp-time-zone: "UTC" ;;; time-stamp-time-zone: "UTC0"
;;; time-stamp-end: "\") ;UTC" ;;; time-stamp-end: "\") ;UTC"
;;; End: ;;; End: