From 5bde4503eeaa1d772744abcf87afc29eb0e9329d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 31 Oct 2016 15:41:14 +0100 Subject: gnu: ld-wrapper-boot0: Work around strict evaluation of (%current-system). Reported by Mark H Weaver Partly fixes . '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. --- gnu/packages/base.scm | 93 ++++++++++++++++++++++++------------------- gnu/packages/commencement.scm | 10 ++++- gnu/packages/cross-base.scm | 2 +- 3 files changed, 60 insertions(+), 45 deletions(-) (limited to 'gnu') 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 @@ (define-public binutils (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 @@ (define* (make-ld-wrapper name #:key binutils ("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 @@ (define texinfo-boot0 (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 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 @@ (define* (cross-gcc target (native-inputs `(("ld-wrapper-cross" ,(make-ld-wrapper (string-append "ld-wrapper-" target) - #:target target + #:target (const target) #:binutils xbinutils)) ("binutils-cross" ,xbinutils) -- cgit v1.2.3