From e85d4cecbe253e59a8a2a42b6ce427d96ff10534 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 11 Apr 2020 00:12:09 +0200 Subject: [PATCH] gnu: commencement: Memoize packages as a function of the system. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 . Reported by Marius Bakke . * 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. --- gnu/packages/commencement.scm | 156 ++++++++++++++++++---------------- tests/guix-build.sh | 6 ++ 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 . - (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)))))))))) - ;; Flex and Bison are required since version 4.16. - ("flex" ,flex-boot0) - ("bison" ,bison-boot0) +(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 . + (package + (inherit linux-libre-headers) + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + ,@(package-arguments linux-libre-headers))) + (native-inputs + `(("perl" ,perl-boot0) - ;; Rsync is required since version 5.3. - ("rsync" ,rsync-boot0) - ,@(%boot0-inputs)))))) + ;; 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))))) (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 . +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"