diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-09-23 22:17:39 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-23 23:41:19 +0200 |
| commit | 24ab804ce11fe12ff49cd144a3d9c4bfcf55b41c (patch) | |
| tree | fa0c67df4051d433e02a6b910717d44ec9bfda41 | |
| parent | 7abd5997f41fec38ea1daa9099a9693062f10dbc (diff) | |
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.
| -rw-r--r-- | guix/gexp.scm | 13 | ||||
| -rw-r--r-- | tests/gexp.scm | 7 |
2 files changed, 19 insertions, 1 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 45cd5869f7..0d0b661c65 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1005,6 +1005,15 @@ references; otherwise, return only non-native references." (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 @@ and in the current monad setting (system type, etc.)" #: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))))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 5c013d838d..50d0948659 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -871,6 +871,13 @@ (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))) |