Update of /cvsroot/sbcl/sbcl/tests
In directory usw-pr-cvs1:/tmp/cvs-serv5165/tests
Modified Files:
defstruct.impure.lisp
Log Message:
0.7.2.17:
Merged MNA "fix for boa-constructor bug" sbcl-devel 2002-04-16
... copied the fix to &optional arguments handling
... also test the &optional handling
Index: defstruct.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/defstruct.impure.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** defstruct.impure.lisp 1 Nov 2001 20:24:55 -0000 1.5
--- defstruct.impure.lisp 19 Apr 2002 10:51:28 -0000 1.6
***************
*** 178,182 ****
(defvar *instance*)
! (defmacro test-variant (defstructname &key colontype)
`(progn
--- 178,182 ----
(defvar *instance*)
! (defmacro test-variant (defstructname &key colontype boa-constructor-p)
`(progn
***************
*** 184,188 ****
(defstruct (,defstructname
! ,@(when colontype `((:type ,colontype))))
;; some ordinary tagged slots
id
--- 184,201 ----
(defstruct (,defstructname
! ,@(when colontype `((:type ,colontype)))
! ,@(when boa-constructor-p
! `((:constructor ,(symbol+ "CREATE-" defstructname)
! (id
! &optional
! (optional-test 2 optional-test-p)
! &key
! (home nil home-p)
! (no-home-comment "Home package CL not provided.")
! (comment (if home-p "" no-home-comment))
! (refcount (if optional-test-p optional-test nil))
! hash
! weight)))))
!
;; some ordinary tagged slots
id
***************
*** 198,207 ****
(let* ((cn (string+ ',defstructname "-")) ; conc-name
! (ctor (symbol-function (symbol+ "MAKE-" ',defstructname)))
(*instance* (funcall ctor
! :id "some id"
:home (find-package :cl)
:hash (+ 14 most-positive-fixnum)
! :refcount 1)))
;; Check that ctor set up slot values correctly.
--- 211,227 ----
(let* ((cn (string+ ',defstructname "-")) ; conc-name
! (ctor (symbol-function ',(symbol+ (if boa-constructor-p
! "CREATE-"
! "MAKE-")
! defstructname)))
(*instance* (funcall ctor
! ,@(unless boa-constructor-p
! `(:id)) "some id"
! ,@(when boa-constructor-p
! '(1))
:home (find-package :cl)
:hash (+ 14 most-positive-fixnum)
! ,@(unless boa-constructor-p
! `(:refcount 1)))))
;; Check that ctor set up slot values correctly.
***************
*** 274,277 ****
--- 294,301 ----
(test-variant vector-struct :colontype vector)
(test-variant list-struct :colontype list)
+ (test-variant vanilla-struct :boa-constructor-p t)
+ (test-variant vector-struct :colontype vector :boa-constructor-p t)
+ (test-variant list-struct :colontype list :boa-constructor-p t)
+
;;;; testing raw slots harder
|