[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/05: gexp: Allow <gexp-input> objects in #:allowed-references.
From: |
Ludovic Courtès |
Subject: |
02/05: gexp: Allow <gexp-input> objects in #:allowed-references. |
Date: |
Sun, 22 Mar 2015 22:43:58 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit accb682c5027cb91104cce7786f9dc4403adf51c
Author: Ludovic Courtès <address@hidden>
Date: Sat Mar 21 23:21:53 2015 +0100
gexp: Allow <gexp-input> objects in #:allowed-references.
* guix/gexp.scm (lower-references): Add <gexp-input> case.
* tests/gexp.scm ("gexp->derivation #:allowed-references, specific
output"): New test.
---
guix/gexp.scm | 5 +++++
tests/gexp.scm | 17 +++++++++++++++++
2 files changed, 22 insertions(+), 0 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 4a2a924..218914c 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -201,6 +201,11 @@ names and file names suitable for the #:allowed-references
argument to
(match-lambda
((? string? output)
(return output))
+ (($ <gexp-input> thing output native?)
+ (mlet* %store-monad ((lower -> (lookup-compiler thing))
+ (drv (lower thing system
+ (if native? #f target))))
+ (return (derivation->output-path drv output))))
(thing
(mlet* %store-monad ((lower -> (lookup-compiler thing))
(drv (lower thing system target)))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 4c31e22..27c0846 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -497,6 +497,23 @@
(list "out" %bootstrap-guile))))
(built-derivations (list drv))))
+(test-assertm "gexp->derivation #:allowed-references, specific output"
+ (mlet* %store-monad ((in (gexp->derivation "thing"
+ #~(begin
+ (mkdir #$output:ok)
+ (mkdir #$output:not-ok))))
+ (drv (gexp->derivation "allowed-refs"
+ #~(begin
+ (pk #$in:not-ok)
+ (mkdir #$output)
+ (chdir #$output)
+ (symlink #$output "self")
+ (symlink #$in:ok "ok"))
+ #:allowed-references
+ (list "out"
+ (gexp-input in "ok")))))
+ (built-derivations (list drv))))
+
(test-assert "gexp->derivation #:allowed-references, disallowed"
(let ((drv (run-with-store %store
(gexp->derivation "allowed-refs"