~ruther/guix-local: gexp: 'computed-file' always uses a native Guile.

7f6dd3be3dceb0fda15fd02c9165614b2626813e — Ludovic Courtès 4 years ago 7d580f1

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.

patch browse .tar.gz .zip

2 files changed, 23 insertions(+), 1 deletions(-)

M guix/gexp.scm
M tests/gexp.scm

M guix/gexp.scm => guix/gexp.scm +1 -1

@@ 598,7 598,7 @@ This is the declarative counterpart of 'gexp->derivation'."
   (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)))))

M tests/gexp.scm => tests/gexp.scm +22 -0

@@ 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)))