02/05: gexp: Allow <gexp-input> objects in #:allowed-references.

[Ludovic Courtès]

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"