(defun bug178alternative (x)
(funcall (the nil x)))
-181: "bad type specifier drops compiler into debugger"
- Compiling
- (in-package :cl-user)
- (defun bar (x)
- (declare (type 0 x))
- (cons x x))
- signals
- bad thing to be a type specifier: 0
- which seems fine, but also enters the debugger (instead of having
- the compiler handle the error, convert it into a COMPILER-ERROR, and
- continue compiling) which seems wrong.
-
183: "IEEE floating point issues"
Even where floating point handling is being dealt with relatively
well (as of sbcl-0.7.5, on sparc/sunos and alpha; see bug #146), the
* The compiler's handling TYPE-ERRORs which it can prove will
inevitably happen at runtime has been cleaned up and corrected
in several ways. (thanks to Alexey Dejneka)
+ * fixed bug 181: compiler checks validity of user supplied type
+ specifiers
planned incompatible changes in 0.7.x:
* When the profiling interface settles down, maybe in 0.7.x, maybe
# Install SBCL files into the usual places.
+cp /usr/local/bin/sbcl /usr/local/bin/sbcl.old
+cp /usr/local/lib/sbcl.core /usr/local/lib/sbcl.core.old
+
cp src/runtime/sbcl /usr/local/bin/
cp output/sbcl.core /usr/local/lib/
cp doc/sbcl.1 /usr/local/man/man1/
(let ((simple (and (unsupplied-or-nil adjustable)
(unsupplied-or-nil displaced-to)
(unsupplied-or-nil fill-pointer))))
- (specifier-type
- `(,(if simple 'simple-array 'array)
- ,(cond ((not element-type) t)
- ((constant-continuation-p element-type)
- (continuation-value element-type))
- (t
- '*))
- ,(cond ((not simple)
- '*)
- ((constant-continuation-p dims)
- (let ((val (continuation-value dims)))
- (if (listp val) val (list val))))
- ((csubtypep (continuation-type dims)
- (specifier-type 'integer))
- '(*))
- (t
- '*))))))
+ (or (careful-specifier-type
+ `(,(if simple 'simple-array 'array)
+ ,(cond ((not element-type) t)
+ ((constant-continuation-p element-type)
+ (continuation-value element-type))
+ (t
+ '*))
+ ,(cond ((not simple)
+ '*)
+ ((constant-continuation-p dims)
+ (let ((val (continuation-value dims)))
+ (if (listp val) val (list val))))
+ ((csubtypep (continuation-type dims)
+ (specifier-type 'integer))
+ '(*))
+ (t
+ '*))))
+ (specifier-type 'array))))
;;; Complex array operations should assert that their array argument
;;; is complex. In SBCL, vectors with fill-pointers are complex.
"ELEMENT-TYPE is not constant."))
(t
(continuation-value element-type))))
- (eltype-type (specifier-type eltype))
+ (eltype-type (ir1-transform-specifier-type eltype))
(saetp (find-if (lambda (saetp)
(csubtypep eltype-type (saetp-ctype saetp)))
*specialized-array-element-type-properties*))
(unless saetp
(give-up-ir1-transform "ELEMENT-TYPE not found in *SAETP*: ~S" eltype))
-
+
(cond ((or (null initial-element)
(and (constant-continuation-p initial-element)
(eql (continuation-value initial-element)
(%data-vector-and-index array 0)
(fill vector initial-element))
array)))))
-
+
;;; The integer type restriction on the length ensures that it will be
;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and
;;; :DISPLACED-TO keywords ensures that it will be simple; the lack of
(continuation-value length)
'*))
(result-type-spec `(simple-array ,eltype (,len)))
- (eltype-type (specifier-type eltype))
+ (eltype-type (ir1-transform-specifier-type eltype))
(saetp (find-if (lambda (saetp)
(csubtypep eltype-type (saetp-ctype saetp)))
*specialized-array-element-type-properties*)))
;;; many branches there are going to be.
(defun ir1ize-the-or-values (type cont lexenv place)
(declare (type continuation cont) (type lexenv lexenv))
- (let* ((ctype (if (typep type 'ctype) type (values-specifier-type type)))
+ (let* ((ctype (if (typep type 'ctype) type (compiler-values-specifier-type type)))
(old-type (or (lexenv-find cont type-restrictions)
*wild-type*))
(intersects (values-types-equal-or-intersect old-type ctype))
;;; this didn't seem to expand into an assertion, at least for ALIEN
;;; values. Check that SBCL doesn't have this problem.
(def-ir1-translator the ((type value) start cont)
- (with-continuation-type-assertion (cont (values-specifier-type type)
+ (with-continuation-type-assertion (cont (compiler-values-specifier-type type)
"in THE declaration")
(ir1-convert start cont value)))
(def-ir1-translator truly-the ((type value) start cont)
#!+sb-doc
(declare (inline member))
- (let ((type (values-specifier-type type))
+ (let ((type (compiler-values-specifier-type type))
(old (find-uses cont)))
(ir1-convert start cont value)
(do-uses (use cont)
;;; macro, we just wrap a THE around the expansion.
(defun process-type-decl (decl res vars)
(declare (list decl vars) (type lexenv res))
- (let ((type (specifier-type (first decl))))
+ (let ((type (compiler-specifier-type (first decl))))
(collect ((restr nil cons)
(new-vars nil cons))
(dolist (var-name (rest decl))
;;; functions.
(defun process-ftype-decl (spec res names fvars)
(declare (list spec names fvars) (type lexenv res))
- (let ((type (specifier-type spec)))
+ (let ((type (compiler-specifier-type spec)))
(collect ((res nil cons))
(dolist (name names)
(let ((found (find name fvars
(funcall warn-fun "Lisp error during ~A:~%~A" context condition)
(return-from careful-call (values nil nil))))))
t))
+
+;;; Variations of SPECIFIER-TYPE for parsing possibly wrong
+;;; specifiers.
+(macrolet
+ ((deffrob (basic careful compiler transform)
+ `(progn
+ (defun ,careful (specifier)
+ (handler-case (,basic specifier)
+ (simple-error (condition)
+ (values nil (list* (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition))))))
+ (defun ,compiler (specifier)
+ (multiple-value-bind (type error-args) (,careful specifier)
+ (or type
+ (apply #'compiler-error error-args))))
+ (defun ,transform (specifier)
+ (multiple-value-bind (type error-args) (,careful specifier)
+ (or type
+ (apply #'give-up-ir1-transform
+ error-args)))))))
+ (deffrob specifier-type careful-specifier-type compiler-specifier-type ir1-transform-specifier-type)
+ (deffrob values-specifier-type careful-values-specifier-type compiler-values-specifier-type ir1-transform-values-specifier-type))
+
\f
;;;; utilities used at run-time for parsing &KEY args in IR1
(declare (type combination call))
(let ((cont (nth (1- n) (combination-args call))))
(when (and cont (constant-continuation-p cont))
- (specifier-type (continuation-value cont))))))
+ (careful-specifier-type (continuation-value cont))))))
(/show0 "knownfun.lisp end of file")
`(sequence-of-checked-length-given-type ,bare
result-type-arg))
(t
- (let ((result-ctype (specifier-type result-type)))
+ (let ((result-ctype (ir1-transform-specifier-type result-type)))
(if (array-type-p result-ctype)
(let* ((dims (array-type-dimensions result-ctype))
(dim (first dims)))
(give-up-ir1-transform))
(ir1-transform-type-predicate
object
- (specifier-type (continuation-value type))))
+ (ir1-transform-specifier-type (continuation-value type))))
;;; This is the IR1 transform for simple type predicates. It checks
;;; whether the single argument is known to (not) be of the
;; source transform another chance, so it all works out OK, in a
;; weird roundabout way. -- WHN 2001-03-18
(if (and (consp spec) (eq (car spec) 'quote))
- (let ((type (specifier-type (cadr spec))))
- (or (let ((pred (cdr (assoc type *backend-type-predicates*
+ (let ((type (careful-specifier-type (cadr spec))))
+ (or (when (not type)
+ (compiler-warn "illegal type specifier for TYPEP: ~S"
+ (cadr spec))
+ `(%typep ,object ,spec))
+ (let ((pred (cdr (assoc type *backend-type-predicates*
:test #'type=))))
(when pred `(,pred ,object)))
(typecase type
(deftransform coerce ((x type) (* *) *)
(unless (constant-continuation-p type)
(give-up-ir1-transform))
- (let ((tspec (specifier-type (continuation-value type))))
+ (let ((tspec (ir1-transform-specifier-type (continuation-value type))))
(if (csubtypep (continuation-type x) tspec)
'x
;; Note: The THE here makes sure that specifiers like
`(the ,(continuation-value type)
,(cond
((csubtypep tspec (specifier-type 'double-float))
- '(%double-float x))
+ '(%double-float x))
;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed"))
((csubtypep tspec (specifier-type 'float))
'(%single-float x))
;;; "(LEAF-HAS-SOURCE-NAME-P LEAF)")
(assert (= (funcall (eval `(lambda (x) (funcall ,(lambda (y) (+ y 3)) x))) 14)
17))
+
+;;; bug 181: bad type specifier dropped compiler into debugger
+(assert (list (compile nil '(lambda (x)
+ (declare (type (0) x))
+ x))))
+
+(let ((f (compile nil '(lambda (x)
+ (make-array 1 :element-type '(0))))))
+ (assert (null (ignore-errors (funcall f)))))
;;; internal versions off the main CVS branch, it gets hairier, e.g.
;;; "0.pre7.14.flaky4.13".)
-"0.7.7.33"
+"0.7.7.34"
projects / sbcl.git / commitdiff