From: Nikodemus S. <de...@us...> - 2007-11-26 18:06:10
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv24269/tests Modified Files: type.impure.lisp Log Message: 1.0.12.3: less weakening of type-checks * WEAKEN-TYPE used to return T for any union-type. Instead, handle union-types implemented by backend properly. * Also, if no supertype is found, don't replaces with T, as eg. oddball union types weakened to T can easily lead to heap corruption if the unchecked object ends up being trusted by the compiler. (See: WEAKEN-UNION-2 in type.impure.lisp.) Index: type.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/type.impure.lisp,v retrieving revision 1.50 retrieving revision 1.51 diff -u -d -r1.50 -r1.51 --- type.impure.lisp 7 Nov 2006 10:22:18 -0000 1.50 +++ type.impure.lisp 26 Nov 2007 18:06:07 -0000 1.51 @@ -558,4 +558,27 @@ (not sb-eval:interpreted-function)) nil)) +;;; weakening of union type checks +(defun weaken-union-1 (x) + (declare (optimize speed)) + (car x)) +(multiple-value-bind (res err) + (ignore-errors (weaken-union-1 "askdjhasdkj")) + (assert (not res)) + (assert (typep err 'type-error))) +(defun weaken-union-2 (x) + (declare (optimize speed) + (type (or cons fixnum) x)) + (etypecase x + (fixnum x) + (cons + (setf (car x) 3) + x))) +(multiple-value-bind (res err) + (ignore-errors (weaken-union-2 "asdkahsdkhj")) + (assert (not res)) + (assert (typep err 'type-error)) + (assert (or (equal '(or cons fixnum) (type-error-expected-type err)) + (equal '(or fixnum cons) (type-error-expected-type err))))) + ;;; success |