ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: commencement: Memoize packages as a function of the system.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2020-04-11 00:12:09 +02:00
parent bdb90df764
commit e85d4cecbe
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 91 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

156
gnu/packages/commencement.scm
View file

@ -2999,29 +2999,45 @@ (define rsync-boot0
`(#:implicit-inputs? #f `(#:implicit-inputs? #f
#:guile ,%bootstrap-guile)))) #:guile ,%bootstrap-guile))))
(define linux-libre-headers-boot0 (define-syntax define/system-dependent
(mlambda () (lambda (s)
"Return Linux-Libre header files for the bootstrap environment." "Bind IDENTIFIER to EXP, where the value of EXP is known to depend on
;; Note: this is wrapped in a thunk to nicely handle circular dependencies '%current-system'. The definition ensures that (1) EXP is \"thunked\" so that
;; between (gnu packages linux) and this module. Additionally, memoize it sees the right value of '%current-system', and (2) that its result is
;; the result to play well with further memoization and code that relies memoized as a function of '%current-system'."
;; on pointer identity; see <https://bugs.gnu.org/30155>. (syntax-case s ()
(package ((_ identifier exp)
(inherit linux-libre-headers) (with-syntax ((memoized (datum->syntax #'identifier
(arguments (symbol-append
`(#:guile ,%bootstrap-guile (syntax->datum #'identifier)
#:implicit-inputs? #f '/memoized))))
,@(package-arguments linux-libre-headers))) #'(begin
(native-inputs (define memoized
`(("perl" ,perl-boot0) (mlambda (system) exp))
(define-syntax identifier
(identifier-syntax (memoized (%current-system))))))))))
;; Flex and Bison are required since version 4.16. (define/system-dependent linux-libre-headers-boot0
("flex" ,flex-boot0) ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
("bison" ,bison-boot0) ;; 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)
;; Rsync is required since version 5.3. ;; Flex and Bison are required since version 4.16.
("rsync" ,rsync-boot0) ("flex" ,flex-boot0)
,@(%boot0-inputs)))))) ("bison" ,bison-boot0)
;; Rsync is required since version 5.3.
("rsync" ,rsync-boot0)
,@(%boot0-inputs)))))
(define with-boot0 (define with-boot0
(package-with-explicit-inputs %boot0-inputs (package-with-explicit-inputs %boot0-inputs
@ -3083,23 +3099,22 @@ (define hurd-minimal-boot0
(inputs '())))) (inputs '()))))
(with-boot0 (package-with-bootstrap-guile hurd-minimal)))) (with-boot0 (package-with-bootstrap-guile hurd-minimal))))
(define hurd-core-headers-boot0 (define/system-dependent hurd-core-headers-boot0
(mlambda () ;; Return the Hurd and Mach headers as well as initial Hurd libraries for
"Return the Hurd and Mach headers as well as initial Hurd libraries for ;; the bootstrap environment.
the bootstrap environment." (package (inherit (package-with-bootstrap-guile hurd-core-headers))
(package (inherit (package-with-bootstrap-guile hurd-core-headers)) (arguments `(#:guile ,%bootstrap-guile
(arguments `(#:guile ,%bootstrap-guile ,@(package-arguments hurd-core-headers)))
,@(package-arguments hurd-core-headers))) (inputs
(inputs `(("gnumach-headers" ,gnumach-headers-boot0)
`(("gnumach-headers" ,gnumach-headers-boot0) ("hurd-headers" ,hurd-headers-boot0)
("hurd-headers" ,hurd-headers-boot0) ("hurd-minimal" ,hurd-minimal-boot0)
("hurd-minimal" ,hurd-minimal-boot0) ,@(%boot0-inputs)))))
,@(%boot0-inputs))))))
(define* (kernel-headers-boot0 #:optional (system (%current-system))) (define* (kernel-headers-boot0 #:optional (system (%current-system)))
(match system (match system
("i586-gnu" (hurd-core-headers-boot0)) ("i586-gnu" hurd-core-headers-boot0)
(_ (linux-libre-headers-boot0)))) (_ linux-libre-headers-boot0)))
(define texinfo-boot0 (define texinfo-boot0
;; Texinfo used to build libc's manual. ;; Texinfo used to build libc's manual.
@ -3205,21 +3220,23 @@ (define python-boot0
(delete 'set-TZDIR))) (delete 'set-TZDIR)))
((#:tests? _ #f) #f)))))) ((#:tests? _ #f) #f))))))
(define ld-wrapper-boot0 (define/system-dependent ld-wrapper-boot0
(mlambda () ;; The first 'ld' wrapper, defined with 'define/system-dependent' because
;; We need this so binaries on Hurd will have libmachuser and libhurduser ;; its calls '%boot0-inputs', whose result depends on (%current-system)
;; in their RUNPATH, otherwise validate-runpath will fail. ;;
(make-ld-wrapper "ld-wrapper-boot0" ;; We need this so binaries on Hurd will have libmachuser and libhurduser
#:target boot-triplet ;; in their RUNPATH, otherwise validate-runpath will fail.
#:binutils binutils-boot0 (make-ld-wrapper "ld-wrapper-boot0"
#:guile %bootstrap-guile #:target boot-triplet
#:bash (car (assoc-ref (%boot0-inputs) "bash")) #:binutils binutils-boot0
#:guile-for-build %bootstrap-guile))) #:guile %bootstrap-guile
#:bash (car (assoc-ref (%boot0-inputs) "bash"))
#:guile-for-build %bootstrap-guile))
(define (%boot1-inputs) (define (%boot1-inputs)
;; 2nd stage inputs. ;; 2nd stage inputs.
`(("gcc" ,gcc-boot0) `(("gcc" ,gcc-boot0)
("ld-wrapper-cross" ,(ld-wrapper-boot0)) ("ld-wrapper-cross" ,ld-wrapper-boot0)
("binutils-cross" ,binutils-boot0) ("binutils-cross" ,binutils-boot0)
,@(alist-delete "binutils" (%boot0-inputs)))) ,@(alist-delete "binutils" (%boot0-inputs))))
@ -3345,20 +3362,19 @@ (define (wrap-program program)
("bash" ,bash))) ("bash" ,bash)))
(inputs '()))) (inputs '())))
(define gcc-boot0-intermediate-wrapped (define/system-dependent gcc-boot0-intermediate-wrapped
(mlambda () ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the ;; non-cross names.
;; non-cross names. (cross-gcc-wrapper gcc-boot0 binutils-boot0
(cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final-with-bootstrap-bash
glibc-final-with-bootstrap-bash (car (assoc-ref (%boot1-inputs) "bash"))))
(car (assoc-ref (%boot1-inputs) "bash")))))
(define static-bash-for-glibc (define static-bash-for-glibc
;; A statically-linked Bash to be used by GLIBC-FINAL in system(3) & co. ;; A statically-linked Bash to be used by GLIBC-FINAL in system(3) & co.
(package (package
(inherit static-bash) (inherit static-bash)
(source (bootstrap-origin (package-source 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" ,glibc-final-with-bootstrap-bash)
("libc:static" ,glibc-final-with-bootstrap-bash "static") ("libc:static" ,glibc-final-with-bootstrap-bash "static")
,@(fold alist-delete (%boot1-inputs) ,@(fold alist-delete (%boot1-inputs)
@ -3446,18 +3462,17 @@ (define glibc-final
,@(package-outputs glibc-final-with-bootstrap-bash)) ,@(package-outputs glibc-final-with-bootstrap-bash))
,@(package-arguments glibc-final-with-bootstrap-bash))))) ,@(package-arguments glibc-final-with-bootstrap-bash)))))
(define gcc-boot0-wrapped (define/system-dependent gcc-boot0-wrapped
(mlambda () ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the ;; non-cross names.
;; non-cross names. (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
(cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final (car (assoc-ref (%boot1-inputs) "bash"))))
(car (assoc-ref (%boot1-inputs) "bash")))))
(define (%boot2-inputs) (define (%boot2-inputs)
;; 3rd stage inputs. ;; 3rd stage inputs.
`(("libc" ,glibc-final) `(("libc" ,glibc-final)
("libc:static" ,glibc-final "static") ("libc:static" ,glibc-final "static")
("gcc" ,(gcc-boot0-wrapped)) ("gcc" ,gcc-boot0-wrapped)
,@(fold alist-delete (%boot1-inputs) '("libc" "gcc" "linux-libre-headers")))) ,@(fold alist-delete (%boot1-inputs) '("libc" "gcc" "linux-libre-headers"))))
(define binutils-final (define binutils-final
@ -3511,14 +3526,13 @@ (define zlib-final
,@(package-arguments zlib))) ,@(package-arguments zlib)))
(inputs (%boot2-inputs)))) (inputs (%boot2-inputs))))
(define ld-wrapper-boot3 (define/system-dependent ld-wrapper-boot3
(mlambda () ;; A linker wrapper that uses the bootstrap Guile.
;; A linker wrapper that uses the bootstrap Guile. (make-ld-wrapper "ld-wrapper-boot3"
(make-ld-wrapper "ld-wrapper-boot3" #:binutils binutils-final
#:binutils binutils-final #:guile %bootstrap-guile
#:guile %bootstrap-guile #:bash (car (assoc-ref (%boot2-inputs) "bash"))
#:bash (car (assoc-ref (%boot2-inputs) "bash")) #:guile-for-build %bootstrap-guile))
#:guile-for-build %bootstrap-guile)))
(define gcc-final (define gcc-final
;; The final GCC. ;; The final GCC.
@ -3594,7 +3608,7 @@ (define gcc-final
(inputs `(("gmp-source" ,(bootstrap-origin (package-source gmp-6.0))) (inputs `(("gmp-source" ,(bootstrap-origin (package-source gmp-6.0)))
("mpfr-source" ,(package-source mpfr)) ("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc)) ("mpc-source" ,(package-source mpc))
("ld-wrapper" ,(ld-wrapper-boot3)) ("ld-wrapper" ,ld-wrapper-boot3)
("binutils" ,binutils-final) ("binutils" ,binutils-final)
("libstdc++" ,libstdc++) ("libstdc++" ,libstdc++)
("zlib" ,zlib-final) ("zlib" ,zlib-final)
@ -3603,7 +3617,7 @@ (define gcc-final
(define (%boot3-inputs) (define (%boot3-inputs)
;; 4th stage inputs. ;; 4th stage inputs.
`(("gcc" ,gcc-final) `(("gcc" ,gcc-final)
("ld-wrapper" ,(ld-wrapper-boot3)) ("ld-wrapper" ,ld-wrapper-boot3)
,@(alist-delete "gcc" (%boot2-inputs)))) ,@(alist-delete "gcc" (%boot2-inputs))))
(define bash-final (define bash-final

6
tests/guix-build.sh
View file

@ -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" 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 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 # Check --sources option with its arguments
module_dir="t-guix-build-$$" module_dir="t-guix-build-$$"
mkdir "$module_dir" mkdir "$module_dir"