From 7f6dd3be3dceb0fda15fd02c9165614b2626813e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 15 Feb 2022 09:31:42 +0100 Subject: gexp: 'computed-file' always uses a native Guile. 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 af57d1bf6c46f47d82dbc234dde1e16fa8634e9d (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. --- guix/gexp.scm | 2 +- tests/gexp.scm | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index dfeadbd15d..d23683e2a6 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -598,7 +598,7 @@ This is the declarative counterpart of 'gexp->derivation'." (match 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))))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 390cf7a207..bcda516623 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1539,6 +1539,28 @@ importing.* \\(guix config\\) from the host" (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))) -- cgit 1.4.1