mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
gexp: Catch and report non-self-quoting gexp inputs.
Previously we would, for example, generate build scripts in the store; when trying to run them, we'd get a 'read' error due to the presence of #<foo> syntax in there. * guix/gexp.scm (gexp->sexp)[self-quoting?]: New procedure. [reference->sexp]: Check whether the argument in a <gexp-input> box is self-quoting. Raise a '&gexp-input-error' condition if it's not. * tests/gexp.scm ("lower-gexp, non-self-quoting input"): New test.
This commit is contained in:
parent
7abd5997f4
commit
24ab804ce1
2 changed files with 19 additions and 1 deletions
|
@ -1005,6 +1005,15 @@ (define* (gexp->sexp exp #:key
|
|||
(target (%current-target-system)))
|
||||
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
|
||||
and in the current monad setting (system type, etc.)"
|
||||
(define (self-quoting? x)
|
||||
(letrec-syntax ((one-of (syntax-rules ()
|
||||
((_) #f)
|
||||
((_ pred rest ...)
|
||||
(or (pred x)
|
||||
(one-of rest ...))))))
|
||||
(one-of symbol? string? keyword? pair? null? array?
|
||||
number? boolean?)))
|
||||
|
||||
(define* (reference->sexp ref #:optional native?)
|
||||
(with-monad %store-monad
|
||||
(match ref
|
||||
|
@ -1034,8 +1043,10 @@ (define* (reference->sexp ref #:optional native?)
|
|||
#:target target)))
|
||||
;; OBJ must be either a derivation or a store file name.
|
||||
(return (expand thing obj output)))))
|
||||
(($ <gexp-input> x)
|
||||
(($ <gexp-input> (? self-quoting? x))
|
||||
(return x))
|
||||
(($ <gexp-input> x)
|
||||
(raise (condition (&gexp-input-error (input x)))))
|
||||
(x
|
||||
(return x)))))
|
||||
|
||||
|
|
|
@ -871,6 +871,13 @@ (define (matching-input drv output)
|
|||
(eq? (derivation-input-derivation (lowered-gexp-guile lexp))
|
||||
(%guile-for-build)))))))
|
||||
|
||||
(test-eq "lower-gexp, non-self-quoting input"
|
||||
+
|
||||
(guard (c ((gexp-input-error? c)
|
||||
(gexp-error-invalid-input c)))
|
||||
(run-with-store %store
|
||||
(lower-gexp #~(foo #$+)))))
|
||||
|
||||
(test-assertm "gexp->derivation #:references-graphs"
|
||||
(mlet* %store-monad
|
||||
((one (text-file "one" (random-text)))
|
||||
|
|
Loading…
Reference in a new issue