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.
This commit is contained in:
parent
2924f0d6ce
commit
accb682c50
|
@ -201,6 +201,11 @@ names and file names suitable for the #:allowed-references argument to
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((? string? output)
|
((? string? output)
|
||||||
(return 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
|
(thing
|
||||||
(mlet* %store-monad ((lower -> (lookup-compiler thing))
|
(mlet* %store-monad ((lower -> (lookup-compiler thing))
|
||||||
(drv (lower thing system target)))
|
(drv (lower thing system target)))
|
||||||
|
|
|
@ -497,6 +497,23 @@
|
||||||
(list "out" %bootstrap-guile))))
|
(list "out" %bootstrap-guile))))
|
||||||
(built-derivations (list drv))))
|
(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"
|
(test-assert "gexp->derivation #:allowed-references, disallowed"
|
||||||
(let ((drv (run-with-store %store
|
(let ((drv (run-with-store %store
|
||||||
(gexp->derivation "allowed-refs"
|
(gexp->derivation "allowed-refs"
|
||||||
|
|
Loading…
Reference in New Issue