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?'.
This commit is contained in:
Ludovic Courtès 2017-04-03 23:52:19 +02:00
parent b98d4ec0aa
commit 3e43166ffc
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 34 additions and 3 deletions

View File

@ -26,6 +26,8 @@
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (gexp #:export (gexp
gexp? gexp?
@ -84,7 +86,13 @@
gexp-compiler? gexp-compiler?
lower-object lower-object
lower-inputs)) lower-inputs
&gexp-error
gexp-error?
&gexp-input-error
gexp-input-error?
gexp-error-invalid-input))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -140,6 +148,14 @@
(lower gexp-compiler-lower) (lower gexp-compiler-lower)
(expand gexp-compiler-expand)) ;#f | DRV -> sexp (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 (define %gexp-compilers
;; 'eq?' mapping of record type descriptor to <gexp-compiler>. ;; 'eq?' mapping of record type descriptor to <gexp-compiler>.
(make-hash-table 20)) (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. 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 OBJ must be an object that has an associated gexp compiler, such as a
<package>." <package>."
(let ((lower (lookup-compiler obj))) (match (lookup-compiler obj)
(lower obj system target))) (#f
(raise (condition (&gexp-input-error (input obj)))))
(lower
(lower obj system target))))
(define-syntax define-gexp-compiler (define-syntax define-gexp-compiler
(syntax-rules (=> compiler expander) (syntax-rules (=> compiler expander)

View File

@ -26,6 +26,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui) (define-module (guix ui)
#:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix config) #:use-module (guix config)
@ -448,6 +449,10 @@ interpreted."
(location->string loc) (location->string loc)
(package-full-name package) (package-full-name package)
(build-system-name system)))) (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) ((profile-not-found-error? c)
(leave (_ "profile '~a' does not exist~%") (leave (_ "profile '~a' does not exist~%")
(profile-error-profile c))) (profile-error-profile c)))

View File

@ -946,6 +946,13 @@
(string=? (readlink (string-append comp "/text")) (string=? (readlink (string-append comp "/text"))
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" (test-assert "printer"
(string-match "^#<gexp \\(string-append .*#<package coreutils.*\ (string-match "^#<gexp \\(string-append .*#<package coreutils.*\
\"/bin/uname\"\\) [[:xdigit:]]+>$" \"/bin/uname\"\\) [[:xdigit:]]+>$"