aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-07-12 22:11:12 +0200
committerLudovic Courtès <ludo@gnu.org>2014-07-12 23:17:53 +0200
commit5d0984595c77b1b0acd84eb4684f786de5f95aff (patch)
tree4355280e8ae766dfe46923d2e7b0eff6577be7d1
parentf62435e2868f5db15cc2f31300630c8ec873dd58 (diff)
downloadgnu-guix-5d0984595c77b1b0acd84eb4684f786de5f95aff.tar
gnu-guix-5d0984595c77b1b0acd84eb4684f786de5f95aff.tar.gz
gexp: Resolve the default system at '>>=' time.
Partly fixes <http://bugs.gnu.org/18002>. Reported by David Thompson <dthompson2@worcester.edu>. * guix/gexp.scm (gexp->derivation): Change #:system to default #f. Use (%current-system) from within the 'mlet*'. * tests/gexp.scm ("gexp->derivation, default system"): New test.
-rw-r--r--guix/gexp.scm3
-rw-r--r--tests/gexp.scm11
2 files changed, 13 insertions, 1 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 3b154d400f..7d6a882787 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -94,7 +94,7 @@ input list as a monadic value."
(define* (gexp->derivation name exp
#:key
- (system (%current-system))
+ system
hash hash-algo recursive?
(env-vars '())
(modules '())
@@ -114,6 +114,7 @@ The other arguments are as for 'derivation'."
(define outputs (gexp-outputs exp))
(mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp)))
+ (system -> (or system (%current-system)))
(sexp (gexp->sexp exp))
(builder (text-file (string-append name "-builder")
(object->string sexp)))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 60adf497ed..b0ff1019e6 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -211,6 +211,17 @@
(return (string=? (readlink (string-append out "/foo"))
guile))))
+(test-assertm "gexp->derivation, default system"
+ ;; The default system should be the one at '>>=' time, not the one at
+ ;; invocation time. See <http://bugs.gnu.org/18002>.
+ (let ((system (%current-system))
+ (mdrv (parameterize ((%current-system "foobar64-linux"))
+ (gexp->derivation "foo"
+ (gexp
+ (mkdir (ungexp output)))))))
+ (mlet %store-monad ((drv mdrv))
+ (return (string=? system (derivation-system drv))))))
+
(define shebang
(string-append (derivation->output-path guile-for-build)
"/bin/guile --no-auto-compile"))