diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-04-03 23:52:19 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-04-04 00:10:00 +0200 |
commit | 3e43166ffc11fb117c55da594e57866a75625900 (patch) | |
tree | 9f77a65750631ca2b6e5c5a0b7b55daa71f23b73 /guix | |
parent | b98d4ec0aaab744ad3452cc57f9598db58a0e352 (diff) |
gexp: 'lower-object' raises an exception when passed an invalid object.
* guix/gexp.scm (&gexp-error, &gexp-input-error): New error conditions.
(lower-object): Raise &gexp-input-error when 'lookup-compiler' returns #f.
* tests/gexp.scm ("lower-object & gexp-input-error?"): New test.
* guix/ui.scm (call-with-error-handling): Add case for 'gexp-input-error?'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/gexp.scm | 25 | ||||
-rw-r--r-- | guix/ui.scm | 5 |
2 files changed, 27 insertions, 3 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 1b8e43e994..80d8f735b3 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -26,6 +26,8 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (gexp gexp? @@ -84,7 +86,13 @@ gexp-compiler? lower-object - lower-inputs)) + lower-inputs + + &gexp-error + gexp-error? + &gexp-input-error + gexp-input-error? + gexp-error-invalid-input)) ;;; Commentary: ;;; @@ -140,6 +148,14 @@ (lower gexp-compiler-lower) (expand gexp-compiler-expand)) ;#f | DRV -> sexp +(define-condition-type &gexp-error &error + gexp-error?) + +(define-condition-type &gexp-input-error &gexp-error + gexp-input-error? + (input gexp-error-invalid-input)) + + (define %gexp-compilers ;; 'eq?' mapping of record type descriptor to <gexp-compiler>. (make-hash-table 20)) @@ -177,8 +193,11 @@ procedure to expand it; otherwise return #f." corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true. OBJ must be an object that has an associated gexp compiler, such as a <package>." - (let ((lower (lookup-compiler obj))) - (lower obj system target))) + (match (lookup-compiler obj) + (#f + (raise (condition (&gexp-input-error (input obj))))) + (lower + (lower obj system target)))) (define-syntax define-gexp-compiler (syntax-rules (=> compiler expander) diff --git a/guix/ui.scm b/guix/ui.scm index 345bf490b2..b3c94795fe 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -26,6 +26,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix ui) + #:use-module (guix gexp) #:use-module (guix utils) #:use-module (guix store) #:use-module (guix config) @@ -448,6 +449,10 @@ interpreted." (location->string loc) (package-full-name package) (build-system-name system)))) + ((gexp-input-error? c) + (let ((input (package-error-invalid-input c))) + (leave (_ "~s: invalid G-expression input~%") + (gexp-error-invalid-input c)))) ((profile-not-found-error? c) (leave (_ "profile '~a' does not exist~%") (profile-error-profile c))) |