me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2016-10-31 15:41:14 +01:00
parent 77e9c9931e
commit 5bde4503ee
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 57 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
gnu/packages/base.scm
View file

@ -422,14 +422,22 @@ included.")
(license gpl3+) (license gpl3+)
(home-page "http://www.gnu.org/software/binutils/"))) (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)) (guile (canonical-package guile-2.0))
(bash (canonical-package bash)) target (bash (canonical-package bash))
(guile-for-build guile)) (guile-for-build guile))
"Return a package called NAME that contains a wrapper for the 'ld' program "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 of BINUTILS, which adds '-rpath' flags to the actual 'ld' command line. The
TARGET is not #f, make a wrapper for the cross-linker for TARGET, called wrapper uses GUILE and BASH.
'TARGET-ld'. 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 (package
(name name) (name name)
(version "0") (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 ("wrapper" ,(search-path %load-path
"gnu/packages/ld-wrapper.in")))) "gnu/packages/ld-wrapper.in"))))
(arguments (arguments
`(#:guile ,guile-for-build (let ((target (target (%current-system))))
#:modules ((guix build utils)) `(#:guile ,guile-for-build
#:builder (begin #:modules ((guix build utils))
(use-modules (guix build utils) #:builder (begin
(system base compile)) (use-modules (guix build utils)
(system base compile))
(let* ((out (assoc-ref %outputs "out")) (let* ((out (assoc-ref %outputs "out"))
(bin (string-append out "/bin")) (bin (string-append out "/bin"))
(ld ,(if target (ld ,(if target
`(string-append bin "/" ,target "-ld") `(string-append bin "/" ,target "-ld")
'(string-append bin "/ld"))) '(string-append bin "/ld")))
(go (string-append ld ".go"))) (go (string-append ld ".go")))
(setvbuf (current-output-port) _IOLBF) (setvbuf (current-output-port) _IOLBF)
(format #t "building ~s/bin/ld wrapper in ~s~%" (format #t "building ~s/bin/ld wrapper in ~s~%"
(assoc-ref %build-inputs "binutils") (assoc-ref %build-inputs "binutils")
out) out)
(mkdir-p bin) (mkdir-p bin)
(copy-file (assoc-ref %build-inputs "wrapper") ld) (copy-file (assoc-ref %build-inputs "wrapper") ld)
(substitute* ld (substitute* ld
(("@SELF@") (("@SELF@")
ld) ld)
(("@GUILE@") (("@GUILE@")
(string-append (assoc-ref %build-inputs "guile") (string-append (assoc-ref %build-inputs "guile")
"/bin/guile")) "/bin/guile"))
(("@BASH@") (("@BASH@")
(string-append (assoc-ref %build-inputs "bash") (string-append (assoc-ref %build-inputs "bash")
"/bin/bash")) "/bin/bash"))
(("@LD@") (("@LD@")
(string-append (assoc-ref %build-inputs "binutils") (string-append (assoc-ref %build-inputs "binutils")
,(if target ,(if target
(string-append "/bin/" (string-append "/bin/"
target "-ld") target "-ld")
"/bin/ld")))) "/bin/ld"))))
(chmod ld #o555) (chmod ld #o555)
(compile-file ld #:output-file go))))) (compile-file ld #:output-file go))))))
(synopsis "The linker wrapper") (synopsis "The linker wrapper")
(description (description
"The linker wrapper (or 'ld-wrapper') wraps the linker to add any "The linker wrapper (or 'ld-wrapper') wraps the linker to add any

10
gnu/packages/commencement.scm
View file

@ -424,8 +424,14 @@ the bootstrap environment."
(define ld-wrapper-boot0 (define ld-wrapper-boot0
;; We need this so binaries on Hurd will have libmachuser and libhurduser ;; We need this so binaries on Hurd will have libmachuser and libhurduser
;; in their RUNPATH, otherwise validate-runpath will fail. ;; 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 #:binutils binutils-boot0
#:guile %bootstrap-guile #:guile %bootstrap-guile
#:bash (car (assoc-ref %boot0-inputs "bash")))) #:bash (car (assoc-ref %boot0-inputs "bash"))))

2
gnu/packages/cross-base.scm
View file

@ -254,7 +254,7 @@ GCC that does not target a libc; otherwise, target that libc."
(native-inputs (native-inputs
`(("ld-wrapper-cross" ,(make-ld-wrapper `(("ld-wrapper-cross" ,(make-ld-wrapper
(string-append "ld-wrapper-" target) (string-append "ld-wrapper-" target)
#:target target #:target (const target)
#:binutils xbinutils)) #:binutils xbinutils))
("binutils-cross" ,xbinutils) ("binutils-cross" ,xbinutils)