[Openmcl-cvs-notifications] r14021 - /trunk/source/lib/defstruct-lds.lisp

[rme at clozure.com]

Author: rme
Date: Fri Jul 23 00:14:03 2010
New Revision: 14021

Log:
Per test CCL.57879-6, in DEFSTRUCT constructors, try not to complain
about unknown types that may be mentioned in defstruct :type slot
options.

See also r13696.

Modified:
    trunk/source/lib/defstruct-lds.lisp

Modified: trunk/source/lib/defstruct-lds.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/defstruct-lds.lisp (original)
+++ trunk/source/lib/defstruct-lds.lisp Fri Jul 23 00:14:03 2010
@@ -285,10 +285,14 @@
 (defun concat-pnames (name1 name2)
   (intern (%str-cat (string name1) (string name2))))
 =

+;; By special dispensation, don't complain about unknown types
+;; mentioned in defstruct :type slot options.
 (defun wrap-with-type-declaration (value slot &aux (slot-type (ssd-type sl=
ot)))
   (if (eq t slot-type)
     value
-    `(the ,slot-type ,value)))
+    (if (specifier-type-if-known slot-type)
+      `(the ,slot-type ,value)
+      value)))
 =

 (defun make-class-cells-list (class-names)
   (if (and (consp class-names)