From: Nikodemus Siivola Date: Wed, 11 May 2011 11:15:43 +0000 (+0000) Subject: 1.0.48.9: better source information for compile-time type errors X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a1a34a500b880ab761291350300d8d3184574183;p=sbcl.git 1.0.48.9: better source information for compile-time type errors Compile-time warning: in addition to the context, also tell exactly which form produces the value that is not of the expected type. Run-time error: include both the error context and exact form in the error message. Delete VALUES-TYPE-ERROR, and use SIMPLE-TYPE-ERROR for both legs in %COMPILE-TIME-TYPE-ERROR. --- diff --git a/NEWS b/NEWS index bb86954..48085ff 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,8 @@ changes relative to sbcl-1.0.48: are more readable. * enhancement: RUN-PROGRAM works with user-defined binary input and output streams. + * enhancement: more informative compile-time warnings and runtime + errors for type-errors detected at compile-time. * bug fix: blocking reads from FIFOs created by RUN-PROGRAM were uninterruptible, as well as blocking reads from socket streams created with for which :SERVE-EVENTS NIL. (regression from 1.0.42.43) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 58090b2..f46895d 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1688,7 +1688,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "UPDATE-OBJECT-LAYOUT-OR-INVALID" "VALUE-CELL-REF" "VALUE-CELL-SET" "VALUES-SPECIFIER-TYPE" "VALUES-SPECIFIER-TYPE-CACHE-CLEAR" "VALUES-SUBTYPEP" - "VALUES-TYPE" "VALUES-TYPE-ERROR" "VALUES-TYPE-IN" + "VALUES-TYPE" "VALUES-TYPE-IN" "VALUES-TYPE-INTERSECTION" "VALUES-TYPE-MIN-VALUE-COUNT" "VALUES-TYPE-MAX-VALUE-COUNT" "VALUES-TYPE-MAY-BE-SINGLE-VALUE-P" "VALUES-TYPE-OPTIONAL" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index acaf32b..a952750 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1088,15 +1088,6 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) (define-condition encapsulated-condition (condition) ((condition :initarg :condition :reader encapsulated-condition))) -(define-condition values-type-error (type-error) - () - (:report - (lambda (condition stream) - (format stream - "~@" - (type-error-datum condition) - (type-error-expected-type condition))))) - ;;; KLUDGE: a condition for floating point errors when we can't or ;;; won't figure out what type they are. (In FreeBSD and OpenBSD we ;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index dc9cffd..124b488 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -892,26 +892,49 @@ (lvar-source tag) (type-specifier (lvar-type tag)))))) -(defun %compile-time-type-error (values atype dtype) +(defun %compile-time-type-error (values atype dtype context) (declare (ignore dtype)) - (if (and (consp atype) - (eq (car atype) 'values)) - (error 'values-type-error :datum values :expected-type atype) - (error 'type-error :datum (car values) :expected-type atype))) + (destructuring-bind (form . detail) context + (if (and (consp atype) (eq (car atype) 'values)) + (error 'simple-type-error + :datum (car values) + :expected-type atype + :format-control + "~@" + :format-arguments (list values + detail form + atype)) + (error 'simple-type-error + :datum (car values) + :expected-type atype + :format-control "~@" + :format-arguments (list detail form + (car values) + atype))))) (defoptimizer (%compile-time-type-error ir2-convert) - ((objects atype dtype) node block) + ((objects atype dtype context) node block) (let ((*compiler-error-context* node)) (setf (node-source-path node) (cdr (node-source-path node))) - (destructuring-bind (values atype dtype) + (destructuring-bind (values atype dtype context) (basic-combination-args node) (declare (ignore values)) (let ((atype (lvar-value atype)) - (dtype (lvar-value dtype))) - (unless (eq atype nil) - (warn 'type-warning - :format-control - "~@" - :format-arguments (list atype dtype))))) + (dtype (lvar-value dtype)) + (detail (cdr (lvar-value context)))) + (unless (eq atype nil) + (if (constantp detail) + (warn 'type-warning + :format-control + "~@" + :format-arguments (list (eval detail) atype)) + (warn 'type-warning + :format-control + "~@" + :format-arguments (list detail dtype atype)))))) (ir2-convert-full-call node block))) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index f86bff6..9f1085f 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1434,7 +1434,7 @@ ;; FIXME: This function does not return, but due to the implementation ;; of FILTER-LVAR we cannot write it here. -(defknown %compile-time-type-error (t t t) *) +(defknown %compile-time-type-error (t t t t) *) (defknown sb!kernel::case-failure (t t t) nil) (defknown %odd-key-args-error () nil) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 3c5d7a3..59b6bfd 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -2098,17 +2098,20 @@ (unless (eq value-type *empty-type*) ;; FIXME: Do it in one step. - (filter-lvar - value - (if (cast-single-value-p cast) - `(list 'dummy) - `(multiple-value-call #'list 'dummy))) - (filter-lvar - (cast-value cast) - ;; FIXME: Derived type. - `(%compile-time-type-error 'dummy - ',(type-specifier atype) - ',(type-specifier value-type))) + (let ((context (cons (node-source-form cast) + (lvar-source (cast-value cast))))) + (filter-lvar + value + (if (cast-single-value-p cast) + `(list 'dummy) + `(multiple-value-call #'list 'dummy))) + (filter-lvar + (cast-value cast) + ;; FIXME: Derived type. + `(%compile-time-type-error 'dummy + ',(type-specifier atype) + ',(type-specifier value-type) + ',context))) ;; KLUDGE: FILTER-LVAR does not work for non-returning ;; functions, so we declare the return type of ;; %COMPILE-TIME-TYPE-ERROR to be * and derive the real type diff --git a/version.lisp-expr b/version.lisp-expr index 08d7c69..2072a3d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.48.8" +"1.0.48.9"