TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

gexp: 'computed-file' always uses a native Guile.

Browse source 
Fixes a regression whereby, when cross-compiling, 'computed-file' would
use a cross-compiled Guile as its builder, which would fail to run.

Regression introduced in af57d1bf6c (the
problem had always been there but was hidden before behind the (not guile)
condition.)

* guix/gexp.scm (computed-file-compiler): For 'guile', pass #:target #f.
* tests/gexp.scm ("lower-object, computed-file, #:target"): New test.
This commit is contained in:
Ludovic Courtès 2022-02-15 09:31:42 +01:00
parent 7d580f1c2c
commit 7f6dd3be3d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 23 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
guix/gexp.scm
View file

@ -598,7 +598,7 @@ (define-gexp-compiler (computed-file-compiler (file <computed-file>)
(match file
(($ <computed-file> name gexp guile options)
(mlet %store-monad ((guile (lower-object (or guile (default-guile))
system #:target target)))
system #:target #f)))
(apply gexp->derivation name gexp #:guile-for-build guile
#:system system #:target target options)))))

22
tests/gexp.scm
View file

@ -1539,6 +1539,28 @@ (define (contents=? file str)
(cons (derivation-file-name drv)
refs))))))))
(test-assertm "lower-object, computed-file, #:target"
(let* ((target "i586-pc-gnu")
(computed (computed-file "computed-cross"
#~(symlink #$coreutils output)
#:guile (default-guile))))
;; When lowered to TARGET, the derivation of COMPUTED should run natively,
;; using a native Guile, but it should refer to the target COREUTILS.
(mlet* %store-monad ((drv (lower-object computed (%current-system)
#:target target))
(refs (references* (derivation-file-name drv)))
(guile (lower-object (default-guile)
(%current-system)
#:target #f))
(cross (lower-object coreutils #:target target))
(native (lower-object coreutils #:target #f)))
(return (and (string=? (derivation-system (pk 'drv drv)) (%current-system))
(string=? (derivation-builder drv)
(string-append (derivation->output-path guile)
"/bin/guile"))
(not (member (derivation-file-name native) refs))
(member (derivation-file-name cross) refs))))))
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))