01/01: build-system/gnu: Patch /usr/bin/file in all 'configure' files.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 4eb01e5442aa7bbaa880ae8e72bd5d27434855ef
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 9 22:35:33 2015 +0100

    build-system/gnu: Patch /usr/bin/file in all 'configure' files.
    
    * guix/build/utils.scm (patch-/usr/bin/file): New procedure.
    * guix/build/gnu-build-system.scm (patch-usr-bin-file): Rewrite using
      it.  Patch all the files returned by 'find-files' that are executable.
    * gnu/packages/gawk.scm (gawk)[arguments]: Remove use of 'substitute*'
      for 'extension/configure'.
---
 gnu/packages/gawk.scm           |   10 +---------
 guix/build/gnu-build-system.scm |   30 ++++++++----------------------
 guix/build/utils.scm            |   26 +++++++++++++++++++++++++-
 3 files changed, 34 insertions(+), 32 deletions(-)

diff --git a/gnu/packages/gawk.scm b/gnu/packages/gawk.scm
index 74d0720..e0d3f41 100644
--- a/gnu/packages/gawk.scm
+++ b/gnu/packages/gawk.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2014, 2015 Mark H Weaver <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -55,14 +55,6 @@
                           '((substitute* "extension/Makefile.in"
                               (("^.*: check-for-shared-lib-support" match)
                                (string-append "### " match))))
-                          '())
-
-                    ;; XXX FIXME prerelease libtool fails on MIPS in the
-                    ;; absence of /usr/bin/file.
-                    ,@(if (string-prefix? "mips64" (or (%current-target-system)
-                                                       (%current-system)))
-                          '((substitute* "extension/configure"
-                              (("/usr/bin/file") (which "file"))))
                           '())))
 
                 (alist-cons-before
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index cdfba2f..2880168 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -115,29 +115,15 @@ working directory."
 (define* (patch-usr-bin-file #:key native-inputs inputs
                              (patch-/usr/bin/file? #t)
                              #:allow-other-keys)
-  "Patch occurrences of /usr/bin/file in configure, if present."
+  "Patch occurrences of \"/usr/bin/file\" in all the executable 'configure'
+files found in the source tree.  This works around Libtool's Autoconf macros,
+which generates invocations of \"/usr/bin/file\" that are used to determine
+things like the ABI being used."
   (when patch-/usr/bin/file?
-    (let ((file "configure")
-          (file-command (or (and=> (assoc-ref (or native-inputs inputs) "file")
-                                   (cut string-append <> "/bin/file"))
-                            (which "file"))))
-      (cond ((not (file-exists? file))
-             (format (current-error-port)
-                     "patch-usr-bin-file: warning: `~a' not found~%"
-                     file))
-            ((not file-command)
-             (format (current-error-port)
-                     "patch-usr-bin-file: warning: `file' not found in 
PATH~%"))
-            (else
-             (let ((st (stat file)))
-               (substitute* file
-                 (("/usr/bin/file")
-                  (begin
-                    (format (current-error-port)
-                            "patch-usr-bin-file: ~a: changing `~a' to `~a'~%"
-                            file "/usr/bin/file" file-command)
-                    file-command)))
-               (set-file-time file st))))))
+    (for-each (lambda (file)
+                (when (executable-file? file)
+                  (patch-/usr/bin/file file)))
+              (find-files "." "^configure$")))
   #t)
 
 (define* (patch-source-shebangs #:key source #:allow-other-keys)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 86b7ca0..4407f9a 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2013 Andreas Enge <address@hidden>
 ;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
 ;;;
@@ -61,6 +61,7 @@
             set-file-time
             patch-shebang
             patch-makefile-SHELL
+            patch-/usr/bin/file
             fold-port-matches
             remove-store-references
             wrap-program))
@@ -681,6 +682,29 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept 
unchanged."
    (when keep-mtime?
      (set-file-time file st))))
 
+(define* (patch-/usr/bin/file file
+                              #:key
+                              (file-command (which "file"))
+                              (keep-mtime? #t))
+  "Patch occurrences of \"/usr/bin/file\" in FILE, replacing them with
+FILE-COMMAND.  When KEEP-MTIME? is true, keep FILE's modification time
+unchanged."
+  (if (not file-command)
+      (format (current-error-port)
+              "patch-/usr/bin/file: warning: \
+no replacement 'file' command, doing nothing~%")
+      (let ((st (stat file)))
+        (substitute* file
+          (("/usr/bin/file")
+           (begin
+             (format (current-error-port)
+                     "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%"
+                     file "/usr/bin/file" file-command)
+             file-command)))
+
+        (when keep-mtime?
+          (set-file-time file st)))))
+
 (define* (fold-port-matches proc init pattern port
                             #:optional (unmatched (lambda (_ r) r)))
   "Read from PORT character-by-character; for each match against