[bug#42146,2/3] build: substitute: Error when no substitutions were done.
Commit Message
From: Jakub Kądziołka <kuba@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@gmail.com>
Change-Id: I66ed33d72aa73cd35e5642521efec70bf756f86e
---
guix/build/utils.scm | 94 +++++++++++++++++++++++++++++++++----------
tests/build-utils.scm | 63 +++++++++++++++++++----------
2 files changed, 114 insertions(+), 43 deletions(-)
Comments
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> From: Jakub Kądziołka <kuba@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@gmail.com>
> Change-Id: I66ed33d72aa73cd35e5642521efec70bf756f86e
[...]
> -(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
As discussed on IRC recently, I’d suggest:
#:key (require-matches? (%substitute-requires-matches?))
where:
(define %substitute-requires-matches?
(make-parameter #t))
That way it’ll be easier to change the default for entire builds if we
need to.
> + (when require-matches?
> + (let ((failed-patterns (lset-difference
> + string=?
> + (delete-duplicates
> + (map rx->pattern failed-matches))
> + (delete-duplicates
> + (map rx->pattern ok-matches)))))
That’s potentially costly.
Would it be enough to thread a list of unmatched regexps, and to
(delq rx unmatched) every time RX is matched? (This is O(N) but N, the
number of regexps, is typically a handful.)
Then at the end, we’d check whether UNMATCHED is empty.
> + (when (not (null? failed-patterns))
> + (raise (make-condition failed-patterns)))))
SRFI-35 ‘make-condition’ expects different arguments.
Should probably be: (raise (condition (&substitute-error …))).
> + ((substitute* file #:require-matches? require-matches?
> + ((regexp match-var ...) body ...) ...)
Maybe rather:
(substitute* file
((regexp match-var ...) body ...) ...
#:require-matches? require-matches?)
That way we formatting remains unchanged.
> +(test-group "substitute*"
I’d avoid groups: they’re not super useful and the output with the
Automake driver is terrible.
Ludo’.
Hi Ludo’,
On 2023-10-19 21:49, Ludovic Courtès wrote:
>> +(test-group "substitute*"
>
> I’d avoid groups: they’re not super useful and the output with the
> Automake driver is terrible.
I personally like using groups for structuring the logic of the tests.
The output issue sounds either like a bug to me that should be fixed
or a place for improvement.
Hi,
Bruno Victal <mirai@makinata.eu> writes:
> Hi Ludo’,
>
> On 2023-10-19 21:49, Ludovic Courtès wrote:
>>> +(test-group "substitute*"
>>
>> I’d avoid groups: they’re not super useful and the output with the
>> Automake driver is terrible.
>
> I personally like using groups for structuring the logic of the tests.
>
> The output issue sounds either like a bug to me that should be fixed
> or a place for improvement.
Ludo, could you refresh my memory about what is wrong with the Automake
SRFI-64 driver when it comes to tests? I think it used to masks the
tests in its output, but I'm not seeing this now?
Consider the following tests, where the "elm->package-name" and
"infer-elm-package-name" tests are in the "round trip" test group itself
nested in the "elm->package-name and infer-elm-package-name" test group.
tests/configuration.scm contains a "duplicated/conflicting entries" test
group that contains "duplicate sanitizer", "duplicate serializer" and
"conflicting use of serializer + empty-serializer":
--8<---------------cut here---------------start------------->8---
make check TESTS='tests/services/configuration.scm tests/elm.scm' \
SCM_LOG_DRIVER_FLAGS="--brief=no"
--8<---------------cut here---------------end--------------->8---
PASS: tests/services/configuration.scm - default value, no serialization
PASS: tests/services/configuration.scm - wrong type for a field
PASS: tests/services/configuration.scm - default value, custom serializer
PASS: tests/services/configuration.scm - no default value, provided
PASS: tests/services/configuration.scm - no default value, not provided
PASS: tests/services/configuration.scm - serialize-configuration
PASS: tests/services/configuration.scm - serialize-configuration [deprecated]
PASS: tests/services/configuration.scm - serialize-configuration with no-serialization
PASS: tests/services/configuration.scm - serialize-configuration with prefix
PASS: tests/services/configuration.scm - default value, sanitizer
PASS: tests/services/configuration.scm - string value, sanitized to number
PASS: tests/services/configuration.scm - default value, serializer literal
PASS: tests/services/configuration.scm - empty-serializer as literal
PASS: tests/services/configuration.scm - empty-serializer as procedure
PASS: tests/services/configuration.scm - default value, sanitizer, permutation
PASS: tests/services/configuration.scm - default value, serializer, permutation
PASS: tests/services/configuration.scm - string value sanitized to number, permutation
PASS: tests/services/configuration.scm - default value, sanitizer, permutation 2
PASS: tests/services/configuration.scm - default value, serializer, permutation 2
PASS: tests/services/configuration.scm - duplicate sanitizer
PASS: tests/services/configuration.scm - duplicate serializer
PASS: tests/services/configuration.scm - conflicting use of serializer + empty-serializer
PASS: tests/services/configuration.scm - Mix of bare serializer and new syntax
PASS: tests/services/configuration.scm - Mix of bare serializer and new syntax, permutation)
PASS: tests/services/configuration.scm - maybe value serialization
PASS: tests/services/configuration.scm - maybe value serialization of the instance
PASS: tests/services/configuration.scm - maybe value serialization of the instance, unspecified
PASS: tests/services/configuration.scm - symbol maybe value serialization, unspecified
PASS: tests/services/configuration.scm - maybe value without serialization no procedure bound
PASS: tests/services/configuration.scm - maybe type, no default
PASS: tests/services/configuration.scm - maybe type, with default
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infer-elm-package-name
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm->package-name
PASS: tests/elm.scm - infers other name
PASS: tests/elm.scm - infered name round-trips
PASS: tests/elm.scm - elm
PASS: tests/elm.scm - guile
PASS: tests/elm.scm - gcc-toolchain
PASS: tests/elm.scm - font-adobe-source-sans-pro
PASS: tests/elm.scm - (elm->guix-package "elm/core")
PASS: tests/elm.scm - (elm-recursive-import "elm-guix/demo")
============================================================================
Testsuite summary for GNU Guix 1.3.0.48706-b42e6315-dirty
============================================================================
# TOTAL: 85
# PASS: 85
# SKIP: 0
# XFAIL: 0
# FAIL: 0
# XPASS: 0
# ERROR: 0
============================================================================
Observation: the output says nothing about the groups, but at least the
nested tests are correctly listed.
@@ -6,7 +6,8 @@
;;; Copyright © 2018, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2020, 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune@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 (... ...))
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@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)