aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-04-03 23:52:19 +0200
committerLudovic Courtès <ludo@gnu.org>2017-04-04 00:10:00 +0200
commit3e43166ffc11fb117c55da594e57866a75625900 (patch)
tree9f77a65750631ca2b6e5c5a0b7b55daa71f23b73
parentb98d4ec0aaab744ad3452cc57f9598db58a0e352 (diff)
downloadguix-3e43166ffc11fb117c55da594e57866a75625900.tar
guix-3e43166ffc11fb117c55da594e57866a75625900.tar.gz
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?'.
-rw-r--r--guix/gexp.scm25
-rw-r--r--guix/ui.scm5
-rw-r--r--tests/gexp.scm7
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:]]+>$"