From: Nikodemus S. <de...@us...> - 2008-06-30 08:36:03
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv27872/tests Modified Files: compiler.impure.lisp Log Message: 1.0.18.1: correct handling of SATISFIES types in the compiler * CTYPEP used to retur a secondary value of true in cases where the function in question was not foldable. * Slightly sleazily extent SB-C::CONSTANT-FUNCTION-CALL-P (part of CONSTANTP) to return the primary result of the call as the secondary value, so CTYPEP can use it. * Test-case. Index: compiler.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v retrieving revision 1.91 retrieving revision 1.92 diff -u -d -r1.91 -r1.92 --- compiler.impure.lisp 6 Jun 2008 12:00:25 -0000 1.91 +++ compiler.impure.lisp 30 Jun 2008 08:35:59 -0000 1.92 @@ -1669,4 +1669,13 @@ (test f1 f2) (test f1 c2)))) +;;; user-defined satisfies-types cannot be folded +(deftype mystery () '(satisfies mysteryp)) +(defvar *mystery* nil) +(defun mysteryp (x) (eq x *mystery*)) +(defstruct thing (slot (error "missing") :type mystery)) +(defun test-mystery (m) (when (eq :mystery (thing-slot m)) :ok)) +(setf *mystery* :mystery) +(assert (eq :ok (test-mystery (make-thing :slot :mystery)))) + ;;; success |