[bug#42146] [PATCH v3 2/3] build: substitute: Error when no substitutions were done.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

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  | 93 +++++++++++++++++++++++++++++++++----------
 tests/build-utils.scm | 68 +++++++++++++++++++++----------
 2 files changed, 118 insertions(+), 43 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 2b3a8e278b..8e4b8321dd 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -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>
@@ -111,8 +112,14 @@ (define-module (guix build utils)
             modify-phases
 
             with-atomic-file-replacement
+            %substitute-requires-matches?
             substitute
             substitute*
+            &substitute-error
+            substitute-error?
+            substitute-error-file
+            substitute-error-patterns
+
             dump-port
             set-file-time
             patch-shebang
@@ -971,24 +978,51 @@ (define (replace-char c1 c2 s)
                         c))
                   s)))
 
-(define (substitute file pattern+procs)
+(define-condition-type &substitute-error &error
+  substitute-error?
+  (file substitute-error-file)
+  (patterns substitute-error-patterns))
+
+(define %substitute-requires-matches?
+  (make-parameter #t))
+
+(define* (substitute file pattern+procs
+                     #:key (require-matches? (%substitute-requires-matches?)))
   "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 &substitute-error 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)))
+
+  (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))
+                   (unmatched-regexps (map first rx+proc)))
           (if (eof-object? line)
-              #t
+              (when (and require-matches? (not (null? unmatched-regexps)))
+                (raise (condition
+                        (&substitute-error
+                         (file file)
+                         (patterns (map rx->pattern unmatched-regexps))))))
               ;; 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 +1032,23 @@ (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, unmatched-regexps
+                      (fold (lambda (r+p results)
+                              (let ((line (first results))
+                                    (unmatched (second results)))
+                                (match r+p
+                                  ((regexp . proc)
+                                   (match (list-matches* regexp line)
+                                     ((and m+ (_ _ ...))
+                                      (list (proc line m+)
+                                            (delq regexp unmatched)))
+                                     (_ (list line unmatched)))))))
+                            (list line* unmatched-regexps)
+                            rx+proc))
+                     (line1* (first results))
                      (line1 (replace-char nul* #\nul line1*)))
                 (display line1 out)
-                (loop (read-line in 'concat)))))))))
-
+                (loop (read-line in 'concat) (second results)))))))))
 
 (define-syntax let-matches
   ;; Helper macro for `substitute*'.
@@ -1048,9 +1086,19 @@ (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
+       ((regexp match-var ...) body ...) ...
+       #:require-matches? #t))
+    ((substitute* file
+       ((regexp match-var ...) body ...) ...
+       #:require-matches? require-matches?)
      (let ()
        (define (substitute-one-file file-name)
          (substitute
@@ -1074,7 +1122,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..35c66faa3c 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@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,52 @@ (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))))))))
+(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-equal "substitute*, no match, ignored"
+  "abc"                                 ;expected
+  "abc"                                 ;content
+  (("Oops!") "c")
+  #:require-matches? #f)
+
+(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