gnu: ld-wrapper-boot0: Work around strict evaluation of (%current-system).

Reported by Mark H Weaver <mhw@netris.org>
Partly fixes <http://bugs.gnu.org/24832>.

'ld-wrapper-boot0' was evaluating strictly instead of lazily, leading to
invalid system types.

* gnu/packages/base.scm (make-ld-wrapper): Turn #:target into a
one-argument procedure.  Honor it.
* gnu/packages/commencement.scm (ld-wrapper-boot0): Fix 'name' argument
to 'make-ld-wrapper'.  Make #:target argument a procedure.
* gnu/packages/cross-base.scm (cross-gcc): Adjust #:target argument.

3 files changed, 60 insertions, 45 deletions

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 5aea2cee0e..76052ef902 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -422,14 +422,22 @@ included.")
    (license gpl3+)
    (home-page "http://www.gnu.org/software/binutils/")))
 
-(define* (make-ld-wrapper name #:key binutils
+(define* (make-ld-wrapper name #:key
+                          (target (const #f))
+                          binutils
                           (guile (canonical-package guile-2.0))
-                          (bash (canonical-package bash)) target
+                          (bash (canonical-package bash))
                           (guile-for-build guile))
   "Return a package called NAME that contains a wrapper for the 'ld' program
-of BINUTILS, which adds '-rpath' flags to the actual 'ld' command line.  When
-TARGET is not #f, make a wrapper for the cross-linker for TARGET, called
-'TARGET-ld'.  The wrapper uses GUILE and BASH."
+of BINUTILS, which adds '-rpath' flags to the actual 'ld' command line.  The
+wrapper uses GUILE and BASH.
+
+TARGET must be a one-argument procedure that, given a system type, returns a
+cross-compilation target triplet or #f.  When the result is not #f, make a
+wrapper for the cross-linker for that target, called 'TARGET-ld'."
+  ;; Note: #:system->target-triplet is a procedure so that the evaluation of
+  ;; its result can be delayed until the 'arguments' field is evaluated, thus
+  ;; in a context where '%current-system' is accurate.
   (package
     (name name)
     (version "0")
@@ -441,43 +449,44 @@ TARGET is not #f, make a wrapper for the cross-linker for TARGET, called
               ("wrapper"  ,(search-path %load-path
                                         "gnu/packages/ld-wrapper.in"))))
     (arguments
-     `(#:guile ,guile-for-build
-       #:modules ((guix build utils))
-       #:builder (begin
-                   (use-modules (guix build utils)
-                                (system base compile))
-
-                   (let* ((out (assoc-ref %outputs "out"))
-                          (bin (string-append out "/bin"))
-                          (ld  ,(if target
-                                    `(string-append bin "/" ,target "-ld")
-                                    '(string-append bin "/ld")))
-                          (go  (string-append ld ".go")))
-
-                     (setvbuf (current-output-port) _IOLBF)
-                     (format #t "building ~s/bin/ld wrapper in ~s~%"
-                             (assoc-ref %build-inputs "binutils")
-                             out)
-
-                     (mkdir-p bin)
-                     (copy-file (assoc-ref %build-inputs "wrapper") ld)
-                     (substitute* ld
-                       (("@SELF@")
-                        ld)
-                       (("@GUILE@")
-                        (string-append (assoc-ref %build-inputs "guile")
-                                       "/bin/guile"))
-                       (("@BASH@")
-                        (string-append (assoc-ref %build-inputs "bash")
-                                       "/bin/bash"))
-                       (("@LD@")
-                        (string-append (assoc-ref %build-inputs "binutils")
-                                       ,(if target
-                                            (string-append "/bin/"
-                                                           target "-ld")
-                                            "/bin/ld"))))
-                     (chmod ld #o555)
-                     (compile-file ld #:output-file go)))))
+     (let ((target (target (%current-system))))
+       `(#:guile ,guile-for-build
+         #:modules ((guix build utils))
+         #:builder (begin
+                     (use-modules (guix build utils)
+                                  (system base compile))
+
+                     (let* ((out (assoc-ref %outputs "out"))
+                            (bin (string-append out "/bin"))
+                            (ld  ,(if target
+                                      `(string-append bin "/" ,target "-ld")
+                                      '(string-append bin "/ld")))
+                            (go  (string-append ld ".go")))
+
+                       (setvbuf (current-output-port) _IOLBF)
+                       (format #t "building ~s/bin/ld wrapper in ~s~%"
+                               (assoc-ref %build-inputs "binutils")
+                               out)
+
+                       (mkdir-p bin)
+                       (copy-file (assoc-ref %build-inputs "wrapper") ld)
+                       (substitute* ld
+                         (("@SELF@")
+                          ld)
+                         (("@GUILE@")
+                          (string-append (assoc-ref %build-inputs "guile")
+                                         "/bin/guile"))
+                         (("@BASH@")
+                          (string-append (assoc-ref %build-inputs "bash")
+                                         "/bin/bash"))
+                         (("@LD@")
+                          (string-append (assoc-ref %build-inputs "binutils")
+                                         ,(if target
+                                              (string-append "/bin/"
+                                                             target "-ld")
+                                              "/bin/ld"))))
+                       (chmod ld #o555)
+                       (compile-file ld #:output-file go))))))
     (synopsis "The linker wrapper")
     (description
      "The linker wrapper (or 'ld-wrapper') wraps the linker to add any
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 53ba7189b4..2431babcad 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -424,8 +424,14 @@ the bootstrap environment."
 (define ld-wrapper-boot0
   ;; We need this so binaries on Hurd will have libmachuser and libhurduser
   ;; in their RUNPATH, otherwise validate-runpath will fail.
-  (make-ld-wrapper (string-append "ld-wrapper-" (boot-triplet))
-                   #:target (boot-triplet)
+  ;;
+  ;; XXX: Work around <http://bugs.gnu.org/24832> by fixing the name and
+  ;; triplet on GNU/Linux.  For GNU/Hurd, use the right triplet.
+  (make-ld-wrapper (string-append "ld-wrapper-" "x86_64-guix-linux-gnu")
+                   #:target (lambda (system)
+                              (if (string-suffix? "-linux" system)
+                                  "x86_64-guix-linux-gnu"
+                                  (boot-triplet system)))
                    #:binutils binutils-boot0
                    #:guile %bootstrap-guile
                    #:bash (car (assoc-ref %boot0-inputs "bash"))))
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index b4324c2aeb..470bae7bea 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -254,7 +254,7 @@ GCC that does not target a libc; otherwise, target that libc."
     (native-inputs
      `(("ld-wrapper-cross" ,(make-ld-wrapper
                              (string-append "ld-wrapper-" target)
-                             #:target target
+                             #:target (const target)
                              #:binutils xbinutils))
        ("binutils-cross" ,xbinutils)