From accb682c5027cb91104cce7786f9dc4403adf51c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 21 Mar 2015 23:21:53 +0100 Subject: gexp: Allow objects in #:allowed-references. * guix/gexp.scm (lower-references): Add 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(+) diff --git a/guix/gexp.scm b/guix/gexp.scm index 4a2a924a03..218914c4b4 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)) + (($ 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 4c31e22f15..27c08467e7 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" -- cgit v1.2.3