summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-11 00:12:09 +0200
committerLudovic Courtès <ludo@gnu.org>2020-04-11 00:32:41 +0200
commite85d4cecbe253e59a8a2a42b6ce427d96ff10534 (patch)
treeaec7d7d28b272c1d2ab7c02036139ed27383a985
parentbdb90df764661c11b37c988ea129c8e7a01b1889 (diff)
gnu: commencement: Memoize packages as a function of the system.
Previous, things like 'ld-wrapper-boot0' would be memoized with (mlambda () …). However, the definition of 'ld-wrapper-boot0' depends on the result of (%boot0-inputs), which is itself a function of (%current-system). Thus, if one first calls: (parameterize ((%current-system "x86_64-linux")) (ld-wrapper-boot0)) then, in all subsequent calls to 'ld-wrapper-boot0', the value of (%current-system) would be ignored because the result is already memoized. Concretely, 'ld-wrapper-boot0' would always have the dependencies it has on x86_64-linux, even though they are different than those on armhf-linux, say ("bash-mesboot" vs. "bootstrap-binaries"). Fixes <https://bugs.gnu.org/40482>. Reported by Marius Bakke <mbakke@fastmail.com>. * gnu/packages/commencement.scm (define/system-dependent): New macro. (linux-libre-headers-boot0, hurd-core-headers-boot0, ld-wrapper-boot0) (gcc-boot0-intermediate-wrapped, gcc-boot0-wrapped, ld-wrapper-boot3): Define using 'define/system-dependent' instead of 'define' + 'mlambda'. Adjust users so they no longer look like procedure calls. * tests/guix-build.sh: Add test.
-rw-r--r--gnu/packages/commencement.scm156
-rw-r--r--tests/guix-build.sh6
2 files changed, 91 insertions, 71 deletions
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 7e969faafe..41d7772eea 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -2999,29 +2999,45 @@ exec " gcc "/bin/" program
`(#:implicit-inputs? #f
#:guile ,%bootstrap-guile))))
-(define linux-libre-headers-boot0
- (mlambda ()
- "Return Linux-Libre header files for the bootstrap environment."
- ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
- ;; between (gnu packages linux) and this module. Additionally, memoize
- ;; the result to play well with further memoization and code that relies
- ;; on pointer identity; see <https://bugs.gnu.org/30155>.
- (package
- (inherit linux-libre-headers)
- (arguments
- `(#:guile ,%bootstrap-guile
- #:implicit-inputs? #f
- ,@(package-arguments linux-libre-headers)))
- (native-inputs
- `(("perl" ,perl-boot0)
+(define-syntax define/system-dependent
+ (lambda (s)
+ "Bind IDENTIFIER to EXP, where the value of EXP is known to depend on
+'%current-system'. The definition ensures that (1) EXP is \"thunked\" so that
+it sees the right value of '%current-system', and (2) that its result is
+memoized as a function of '%current-system'."
+ (syntax-case s ()
+ ((_ identifier exp)
+ (with-syntax ((memoized (datum->syntax #'identifier
+ (symbol-append
+ (syntax->datum #'identifier)
+ '/memoized))))
+ #'(begin
+ (define memoized
+ (mlambda (system) exp))
+ (define-syntax identifier
+ (identifier-syntax (memoized (%current-system))))))))))
+
+(define/system-dependent linux-libre-headers-boot0
+ ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
+ ;; between (gnu packages linux) and this module. Additionally, memoize
+ ;; the result to play well with further memoization and code that relies
+ ;; on pointer identity; see <https://bugs.gnu.org/30155>.
+ (package
+ (inherit linux-libre-headers)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:implicit-inputs? #f
+ ,@(package-arguments linux-libre-headers)))
+ (native-inputs
+ `(("perl" ,perl-boot0)
- ;; Flex and Bison are required since version 4.16.
- ("flex" ,flex-boot0)
- ("bison" ,bison-boot0)
+ ;; Flex and Bison are required since version 4.16.
+ ("flex" ,flex-boot0)
+ ("bison" ,bison-boot0)
- ;; Rsync is required since version 5.3.
- ("rsync" ,rsync-boot0)
- ,@(%boot0-inputs))))))
+ ;; Rsync is required since version 5.3.
+ ("rsync" ,rsync-boot0)
+ ,@(%boot0-inputs)))))
(define with-boot0
(package-with-explicit-inputs %boot0-inputs
@@ -3083,23 +3099,22 @@ exec " gcc "/bin/" program
(inputs '()))))
(with-boot0 (package-with-bootstrap-guile hurd-minimal))))
-(define hurd-core-headers-boot0
- (mlambda ()
- "Return the Hurd and Mach headers as well as initial Hurd libraries for
-the bootstrap environment."
- (package (inherit (package-with-bootstrap-guile hurd-core-headers))
- (arguments `(#:guile ,%bootstrap-guile
- ,@(package-arguments hurd-core-headers)))
- (inputs
- `(("gnumach-headers" ,gnumach-headers-boot0)
- ("hurd-headers" ,hurd-headers-boot0)
- ("hurd-minimal" ,hurd-minimal-boot0)
- ,@(%boot0-inputs))))))
+(define/system-dependent hurd-core-headers-boot0
+ ;; Return the Hurd and Mach headers as well as initial Hurd libraries for
+ ;; the bootstrap environment.
+ (package (inherit (package-with-bootstrap-guile hurd-core-headers))
+ (arguments `(#:guile ,%bootstrap-guile
+ ,@(package-arguments hurd-core-headers)))
+ (inputs
+ `(("gnumach-headers" ,gnumach-headers-boot0)
+ ("hurd-headers" ,hurd-headers-boot0)
+ ("hurd-minimal" ,hurd-minimal-boot0)
+ ,@(%boot0-inputs)))))
(define* (kernel-headers-boot0 #:optional (system (%current-system)))
(match system
- ("i586-gnu" (hurd-core-headers-boot0))
- (_ (linux-libre-headers-boot0))))
+ ("i586-gnu" hurd-core-headers-boot0)
+ (_ linux-libre-headers-boot0)))
(define texinfo-boot0
;; Texinfo used to build libc's manual.
@@ -3205,21 +3220,23 @@ the bootstrap environment."
(delete 'set-TZDIR)))
((#:tests? _ #f) #f))))))
-(define ld-wrapper-boot0
- (mlambda ()
- ;; We need this so binaries on Hurd will have libmachuser and libhurduser
- ;; in their RUNPATH, otherwise validate-runpath will fail.
- (make-ld-wrapper "ld-wrapper-boot0"
- #:target boot-triplet
- #:binutils binutils-boot0
- #:guile %bootstrap-guile
- #:bash (car (assoc-ref (%boot0-inputs) "bash"))
- #:guile-for-build %bootstrap-guile)))
+(define/system-dependent ld-wrapper-boot0
+ ;; The first 'ld' wrapper, defined with 'define/system-dependent' because
+ ;; its calls '%boot0-inputs', whose result depends on (%current-system)
+ ;;
+ ;; We need this so binaries on Hurd will have libmachuser and libhurduser
+ ;; in their RUNPATH, otherwise validate-runpath will fail.
+ (make-ld-wrapper "ld-wrapper-boot0"
+ #:target boot-triplet
+ #:binutils binutils-boot0
+ #:guile %bootstrap-guile
+ #:bash (car (assoc-ref (%boot0-inputs) "bash"))
+ #:guile-for-build %bootstrap-guile))
(define (%boot1-inputs)
;; 2nd stage inputs.
`(("gcc" ,gcc-boot0)
- ("ld-wrapper-cross" ,(ld-wrapper-boot0))
+ ("ld-wrapper-cross" ,ld-wrapper-boot0)
("binutils-cross" ,binutils-boot0)
,@(alist-delete "binutils" (%boot0-inputs))))
@@ -3345,20 +3362,19 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
("bash" ,bash)))
(inputs '())))
-(define gcc-boot0-intermediate-wrapped
- (mlambda ()
- ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
- ;; non-cross names.
- (cross-gcc-wrapper gcc-boot0 binutils-boot0
- glibc-final-with-bootstrap-bash
- (car (assoc-ref (%boot1-inputs) "bash")))))
+(define/system-dependent gcc-boot0-intermediate-wrapped
+ ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
+ ;; non-cross names.
+ (cross-gcc-wrapper gcc-boot0 binutils-boot0
+ glibc-final-with-bootstrap-bash
+ (car (assoc-ref (%boot1-inputs) "bash"))))
(define static-bash-for-glibc
;; A statically-linked Bash to be used by GLIBC-FINAL in system(3) & co.
(package
(inherit static-bash)
(source (bootstrap-origin (package-source static-bash)))
- (inputs `(("gcc" ,(gcc-boot0-intermediate-wrapped))
+ (inputs `(("gcc" ,gcc-boot0-intermediate-wrapped)
("libc" ,glibc-final-with-bootstrap-bash)
("libc:static" ,glibc-final-with-bootstrap-bash "static")
,@(fold alist-delete (%boot1-inputs)
@@ -3446,18 +3462,17 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
,@(package-outputs glibc-final-with-bootstrap-bash))
,@(package-arguments glibc-final-with-bootstrap-bash)))))
-(define gcc-boot0-wrapped
- (mlambda ()
- ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
- ;; non-cross names.
- (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
- (car (assoc-ref (%boot1-inputs) "bash")))))
+(define/system-dependent gcc-boot0-wrapped
+ ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
+ ;; non-cross names.
+ (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
+ (car (assoc-ref (%boot1-inputs) "bash"))))
(define (%boot2-inputs)
;; 3rd stage inputs.
`(("libc" ,glibc-final)
("libc:static" ,glibc-final "static")
- ("gcc" ,(gcc-boot0-wrapped))
+ ("gcc" ,gcc-boot0-wrapped)
,@(fold alist-delete (%boot1-inputs) '("libc" "gcc" "linux-libre-headers"))))
(define binutils-final
@@ -3511,14 +3526,13 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
,@(package-arguments zlib)))
(inputs (%boot2-inputs))))
-(define ld-wrapper-boot3
- (mlambda ()
- ;; A linker wrapper that uses the bootstrap Guile.
- (make-ld-wrapper "ld-wrapper-boot3"
- #:binutils binutils-final
- #:guile %bootstrap-guile
- #:bash (car (assoc-ref (%boot2-inputs) "bash"))
- #:guile-for-build %bootstrap-guile)))
+(define/system-dependent ld-wrapper-boot3
+ ;; A linker wrapper that uses the bootstrap Guile.
+ (make-ld-wrapper "ld-wrapper-boot3"
+ #:binutils binutils-final
+ #:guile %bootstrap-guile
+ #:bash (car (assoc-ref (%boot2-inputs) "bash"))
+ #:guile-for-build %bootstrap-guile))
(define gcc-final
;; The final GCC.
@@ -3594,7 +3608,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(inputs `(("gmp-source" ,(bootstrap-origin (package-source gmp-6.0)))
("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc))
- ("ld-wrapper" ,(ld-wrapper-boot3))
+ ("ld-wrapper" ,ld-wrapper-boot3)
("binutils" ,binutils-final)
("libstdc++" ,libstdc++)
("zlib" ,zlib-final)
@@ -3603,7 +3617,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(define (%boot3-inputs)
;; 4th stage inputs.
`(("gcc" ,gcc-final)
- ("ld-wrapper" ,(ld-wrapper-boot3))
+ ("ld-wrapper" ,ld-wrapper-boot3)
,@(alist-delete "gcc" (%boot2-inputs))))
(define bash-final
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 1a997de487..6c08857358 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -65,6 +65,12 @@ test `guix build sed -s x86_64-linux -d | wc -l` = 1
all_systems="-s x86_64-linux -s i686-linux -s armhf-linux -s aarch64-linux"
test `guix build sed $all_systems -d | sort -u | wc -l` = 4
+# Check there's no weird memoization effect leading to erroneous results.
+# See <https://bugs.gnu.org/40482>.
+drv1="`guix build sed -s x86_64-linux -s armhf-linux -d | sort`"
+drv2="`guix build sed -s armhf-linux -s x86_64-linux -d | sort`"
+test "$drv1" = "$drv2"
+
# Check --sources option with its arguments
module_dir="t-guix-build-$$"
mkdir "$module_dir"