From: Alexey D. <ade...@us...> - 2003-01-19 09:40:18
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1:/tmp/cvs-serv31925/tests Modified Files: defstruct.impure.lisp eval.impure.lisp Log Message: 0.7.11.10: Fixed some bugs revealed by Paul Dietz' test suite: ** BOA constructor with &AUX argument without a default value does not cause a type error; ** CONSTANTP now returns true for all self-evaluating objects. Index: defstruct.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/defstruct.impure.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- defstruct.impure.lisp 18 Dec 2002 16:41:48 -0000 1.13 +++ defstruct.impure.lisp 19 Jan 2003 09:40:15 -0000 1.14 @@ -23,6 +23,19 @@ (assert (raises-error? (setf (person-name (make-person :name "Q")) 1) type-error)) +;;; An &AUX variable in a boa-constructor without a default value +;;; means "do not initialize slot" and does not cause type error +(defstruct (boa-saux (:constructor make-boa-saux (&aux a (b 3) (c)))) + (a #\! :type (integer 1 2)) + (b #\? :type (integer 3 4)) + (c #\# :type (integer 5 6))) +(let ((s (make-boa-saux))) + (setf (boa-saux-a s) 1) + (setf (boa-saux-c s) 5) + (assert (eql (boa-saux-a s) 1)) + (assert (eql (boa-saux-b s) 3)) + (assert (eql (boa-saux-c s) 5))) + ;;; basic inheritance (defstruct (astronaut (:include person) (:conc-name astro-)) @@ -40,7 +53,7 @@ ;;; interaction of :TYPE and :INCLUDE and :INITIAL-OFFSET (defstruct (binop (:type list) :named (:initial-offset 2)) - (operator '? :type symbol) + (operator '? :type symbol) operand-1 operand-2) (defstruct (annotated-binop (:type list) Index: eval.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/eval.impure.lisp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- eval.impure.lisp 28 Oct 2002 21:37:31 -0000 1.1 +++ eval.impure.lisp 19 Jan 2003 09:40:15 -0000 1.2 @@ -91,8 +91,12 @@ (symbol-macrolet ((foo (symbol-macrolet-bar 1))) (defmacro symbol-macrolet-bar (x) `(+ ,x 1)) (assert (= foo 2))) + +;;; Bug reported by Paul Dietz: CONSTANTP on a self-evaluating object +;;; must return T + +(assert (constantp (find-class 'symbol))) +(assert (constantp #p"")) ;;; success (sb-ext:quit :unix-status 104) - - |