[Sbcl-commits] CVS: sbcl/tests defstruct.impure.lisp,1.13,1.14 eval.impure.lisp,1.1,1.2

[Alexey D. <ade...@us...>]

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)
-
-