Package: guix-patches;
Reported by: Jakub Kądziołka <kuba <at> kadziolka.net>
Date: Tue, 30 Jun 2020 22:10:01 UTC
Severity: normal
Tags: patch
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 42146 <at> debbugs.gnu.org Cc: Jakub Kądziołka <kuba <at> kadziolka.net>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, Jakub Kądziołka <kuba <at> kadziolka.net>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [bug#42146] [PATCH 2/3] build: substitute: Error when no substitutions were done. Date: Thu, 19 Oct 2023 16:33:33 -0400
From: Jakub Kądziołka <kuba <at> kadziolka.net>
* guix/build/utils.scm (substitute, substitute*)
[require-matches?]: New argument.
* tests/build-utils.scm ("substitute*"): New test group.
("substitute*, no match error")
("substitute*, partial no match error"): New tests.
Co-authored-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Change-Id: I66ed33d72aa73cd35e5642521efec70bf756f86e
---
guix/build/utils.scm | 94 +++++++++++++++++++++++++++++++++----------
tests/build-utils.scm | 63 +++++++++++++++++++----------
2 files changed, 114 insertions(+), 43 deletions(-)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 2b3a8e278b..7bfb6560e1 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -6,7 +6,8 @@
;;; Copyright © 2018, 2022 Arun Isaac <arunisaac <at> systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado <at> elephly.net>
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
-;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
+;;; Copyright © 2020, 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail <at> brendan.scot>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune <at> gmail.com>
@@ -971,24 +972,53 @@ (define (replace-char c1 c2 s)
c))
s)))
-(define (substitute file pattern+procs)
+(define* (substitute file pattern+procs #:key (require-matches? #t))
"PATTERN+PROCS is a list of regexp/two-argument-procedure pairs. For each
line of FILE, and for each PATTERN that it matches, call the corresponding
PROC as (PROC LINE MATCHES); PROC must return the line that will be written as
a substitution of the original line. Be careful about using '$' to match the
-end of a line; by itself it won't match the terminating newline of a line."
- (let ((rx+proc (map (match-lambda
- (((? regexp? pattern) . proc)
+end of a line; by itself it won't match the terminating newline of a line.
+
+By default, SUBSTITUTE will raise a &message condition if one of the patterns
+fails to match. REQUIRE-MATCHES? can be set to false when lack of matches is
+acceptable (e.g. if you have multiple potential patterns not guaranteed to be
+found in FILE)."
+ (define (rx->pattern m)
+ (match m
+ ((? regexp? pattern)
+ "<unknown pattern (regexp)>")
+ ((? regexp*? pattern)
+ (regexp*-pattern pattern))
+ ((? string? pattern)
+ pattern)))
+
+ (define (make-condition failed-matches)
+ (condition
+ (&message
+ (message (format #f "substitute: `~a': no match for patterns `~a'"
+ file failed-matches)))))
+
+ (let ((rx+proc (map (match-lambda
+ (((or (? regexp? pattern) (? regexp*? pattern)) . proc)
(cons pattern proc))
((pattern . proc)
- (cons (make-regexp pattern regexp/extended)
- proc)))
- pattern+procs)))
+ (cons (make-regexp* pattern regexp/extended) proc)))
+ pattern+procs)))
(with-atomic-file-replacement file
(lambda (in out)
- (let loop ((line (read-line in 'concat)))
+ (let loop ((line (read-line in 'concat))
+ (ok-matches '())
+ (failed-matches '()))
(if (eof-object? line)
- #t
+ (when require-matches?
+ (let ((failed-patterns (lset-difference
+ string=?
+ (delete-duplicates
+ (map rx->pattern failed-matches))
+ (delete-duplicates
+ (map rx->pattern ok-matches)))))
+ (when (not (null? failed-patterns))
+ (raise (make-condition failed-patterns)))))
;; Work around the fact that Guile's regexp-exec does not handle
;; NUL characters (a limitation of the underlying GNU libc's
;; regexec) by temporarily replacing them by an unused private
@@ -998,19 +1028,30 @@ (define (substitute file pattern+procs)
(unused-private-use-code-point line))
#\nul))
(line* (replace-char #\nul nul* line))
- (line1* (fold (lambda (r+p line)
- (match r+p
- ((regexp . proc)
- (match (list-matches regexp line)
- ((and m+ (_ _ ...))
- (proc line m+))
- (_ line)))))
- line*
- rx+proc))
+ (results ;line, ok-matches and failed-matches
+ (fold (lambda (r+p results)
+ (let ((line (first results))
+ (ok-matches (second results))
+ (failed-matches (third results)))
+ (match r+p
+ ((regexp . proc)
+ (match (list-matches* regexp line)
+ ((and m+ (_ _ ...))
+ (list (proc line m+)
+ (cons regexp ok-matches)
+ failed-matches))
+ (_
+ (list line
+ ok-matches
+ (cons regexp failed-matches))))))))
+ (list line* '() '())
+ rx+proc))
+ (line1* (first results))
+ (ok-matches (second results))
+ (failed-matches (third results))
(line1 (replace-char nul* #\nul line1*)))
(display line1 out)
- (loop (read-line in 'concat)))))))))
-
+ (loop (read-line in 'concat) ok-matches failed-matches))))))))
(define-syntax let-matches
;; Helper macro for `substitute*'.
@@ -1048,9 +1089,17 @@ (define-syntax substitute*
Alternatively, FILE may be a list of file names, in which case they are
all subject to the substitutions.
+By default, SUBSTITUTE* will raise a &message condition if one of the patterns
+fails to match on one of the files; REQUIRE-MATCHES? may be set to false to
+avoid an error being raised in such condition.
+
Be careful about using '$' to match the end of a line; by itself it won't
match the terminating newline of a line."
((substitute* file ((regexp match-var ...) body ...) ...)
+ (substitute* file #:require-matches? #t
+ ((regexp match-var ...) body ...) ...))
+ ((substitute* file #:require-matches? require-matches?
+ ((regexp match-var ...) body ...) ...)
(let ()
(define (substitute-one-file file-name)
(substitute
@@ -1074,7 +1123,8 @@ (define-syntax substitute*
(begin body ...)
(substring l o (match:start m))
r))))))))
- ...)))
+ ...)
+ #:require-matches? require-matches?))
(match file
((files (... ...))
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 3babf5d544..890fbca16f 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado <at> elephly.net>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail <at> brendan.scot>
;;;
@@ -289,26 +289,47 @@ (define (arg-test bash-args)
(test-assert "wrap-script, argument handling, bash --norc"
(arg-test " --norc"))
-(test-equal "substitute*, text contains a NUL byte, UTF-8"
- "c\0d"
- (with-fluids ((%default-port-encoding "UTF-8")
- (%default-port-conversion-strategy 'error))
- ;; The GNU libc is locale sensitive. Depending on the value of LANG, the
- ;; test could fail with "string contains #\\nul character: ~S" or "cannot
- ;; convert wide string to output locale".
- (setlocale LC_ALL "en_US.UTF-8")
- (call-with-temporary-output-file
- (lambda (file port)
- (format port "a\0b")
- (flush-output-port port)
-
- (substitute* file
- (("a") "c")
- (("b") "d"))
-
- (with-input-from-file file
- (lambda _
- (get-string-all (current-input-port))))))))
+(test-group "substitute*"
+ (define-syntax-rule (define-substitute*-test test-type name expected
+ content clauses ...)
+ (test-type
+ name
+ expected
+ (with-fluids ((%default-port-encoding "UTF-8")
+ (%default-port-conversion-strategy 'error))
+ ;; The GNU libc is locale sensitive. Depending on the value of LANG,
+ ;; the test could fail with "string contains #\\nul character: ~S" or
+ ;; "cannot convert wide string to output locale".
+ (setlocale LC_ALL "en_US.UTF-8")
+ (call-with-temporary-output-file
+ (lambda (file port)
+ (format port content)
+ (flush-output-port port)
+
+ (substitute* file
+ clauses ...)
+
+ (with-input-from-file file
+ (lambda _
+ (get-string-all (current-input-port)))))))))
+
+ (define-substitute*-test test-equal
+ "substitute*, text contains a NUL byte, UTF-8"
+ "c\0d" ;expected
+ "a\0b" ;content
+ (("a") "c")
+ (("b") "d"))
+
+ (define-substitute*-test test-error "substitute*, no match error"
+ #t ;expected
+ "a\0b" ;content
+ (("Oops!") "c"))
+
+ (define-substitute*-test test-error "substitute*, partial no match error"
+ #t ;expected
+ "a\0b" ;content
+ (("a") "c"
+ ("Oops!") "c")))
(test-equal "search-input-file: exception if not found"
`((path)
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.