[armedbear-cvs] r13980 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Tue Jun 19 08:01:37 2012
New Revision: 13980

Log:
Pass multiply-specified slot option as a list to direct-slot-definition-class.

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Tue Jun 19 06:52:22 2012	(r13979)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Tue Jun 19 08:01:37 2012	(r13980)
@@ -331,8 +331,7 @@
              (push-on-end (cadr olist) readers)
              (push-on-end `(setf ,(cadr olist)) writers))
             (t
-             (push-on-end `(quote ,(car olist)) non-std-options)
-             (push-on-end `(quote ,(cadr olist)) non-std-options))))
+             (push-on-end (cadr olist) (getf non-std-options (car olist))))))
         `(list
           :name ',name
           ,@(when initfunction
@@ -352,7 +351,10 @@
           ,@(when type `(:type ',type))
           ,@(when documentation `(:documentation ',documentation))
           , at other-options
-	  , at non-std-options))))
+          ,@(mapcar #'(lambda (opt) (if (or (atom opt) (/= 1 (length opt)))
+                                        `',opt
+                                        `',(car opt)))
+                    non-std-options)))))
 
 (defun maybe-note-name-defined (name)
   (when (fboundp 'note-name-defined)