mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
77e9c9931e
commit
5bde4503ee
3 changed files with 57 additions and 42 deletions
|
@ -422,14 +422,22 @@ (define-public binutils
|
||||||
(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 @@ (define* (make-ld-wrapper name #:key binutils
|
||||||
("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
|
||||||
|
|
|
@ -424,8 +424,14 @@ (define texinfo-boot0
|
||||||
(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"))))
|
||||||
|
|
|
@ -254,7 +254,7 @@ (define* (cross-gcc target
|
||||||
(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)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue