me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
* 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:
Ludovic Courtès 2015-03-21 23:21:53 +01:00
parent 2924f0d6ce
commit accb682c50
2 changed files with 22 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
guix/gexp.scm
View file

@ -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)))

17
tests/gexp.scm
View file

@ -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"