diff options
| -rw-r--r-- | guix/gexp.scm | 25 | ||||
| -rw-r--r-- | guix/ui.scm | 5 | ||||
| -rw-r--r-- | tests/gexp.scm | 7 |
3 files changed, 34 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))) diff --git a/tests/gexp.scm b/tests/gexp.scm index b3f7323984..41a53ae5a4 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -946,6 +946,13 @@ (string=? (readlink (string-append comp "/text")) text))))))) +(test-assert "lower-object & gexp-input-error?" + (guard (c ((gexp-input-error? c) + (gexp-error-invalid-input c))) + (run-with-store %store + (lower-object (current-module)) + #:guile-for-build (%guile-for-build)))) + (test-assert "printer" (string-match "^#<gexp \\(string-append .*#<package coreutils.*\ \"/bin/uname\"\\) [[:xdigit:]]+>$" |