From: Nikodemus S. <de...@us...> - 2009-07-29 14:49:02
|
Update of /cvsroot/sbcl/sbcl/tests In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10713/tests Modified Files: clos.impure.lisp Log Message: 1.0.30.9: improved generic-function FTYPE handling * Use :DEFINED-METHOD as :WHERE-FROM even if there is no explicit DEFGENERIC -- initial type becomes FUNCTION. * Also signal a style-warning when the FTYPE is clobbered by a generic function -- though in this case it is more "bad SBCL style" than bad user style... but at least the user will know that something unexpected is going on. (Clobbering itself is not new.) Index: clos.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v retrieving revision 1.103 retrieving revision 1.104 diff -u -d -r1.103 -r1.104 --- clos.impure.lisp 2 Jun 2009 18:33:52 -0000 1.103 +++ clos.impure.lisp 29 Jul 2009 14:48:51 -0000 1.104 @@ -1718,5 +1718,30 @@ (shared-initialize x '(a)) (assert (slot-boundp x 'a)) (assert (eq :ok (slot-value x 'a))))) + +(declaim (ftype (function (t t t) (values single-float &optional)) + i-dont-want-to-be-clobbered-1 + i-dont-want-to-be-clobbered-2)) +(defgeneric i-dont-want-to-be-clobbered-1 (t t t)) +(defmethod i-dont-want-to-be-clobbered-2 ((x cons) y z) + y) +(defun i-cause-an-gf-info-update () + (i-dont-want-to-be-clobbered-2 t t t)) +(with-test (:name :defgeneric-should-clobber-ftype) + ;; (because it doesn't check the argument or result types) + (assert (equal '(function (t t t) *) + (sb-kernel:type-specifier + (sb-int:info :function + :type 'i-dont-want-to-be-clobbered-1)))) + (assert (equal '(function (t t t) *) + (sb-kernel:type-specifier + (sb-int:info :function + :type 'i-dont-want-to-be-clobbered-2)))) + (assert (eq :defined-method + (sb-int:info :function + :where-from 'i-dont-want-to-be-clobbered-1))) + (assert (eq :defined-method + (sb-int:info :function + :where-from 'i-dont-want-to-be-clobbered-2)))) ;;;; success |