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

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Sun Jan 29 14:47:09 2012
New Revision: 13827

Log:
Fix ansi tests class-0309, class-0310.1

... ensure-class now redefines a class found by (FIND-CLASS NAME) only
    if NAME is eql to (CLASS-NAME CLASS) as well.

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	Sun Jan 29 14:09:01 2012	(r13826)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jan 29 14:47:09 2012	(r13827)
@@ -2656,7 +2656,13 @@
 
  ;;; AMOP pg. 182
 (defun ensure-class (name &rest all-keys &key &allow-other-keys)
-  (apply #'ensure-class-using-class (find-class name nil) name all-keys))
+  (let ((class (find-class name nil)))
+    ;; CLHS DEFCLASS: "If a class with the same proper name already
+    ;; exists [...] the existing class is redefined."  Ansi-tests
+    ;; CLASS-0309 and CLASS-0310.1 demand this behavior.
+    (if (and class (eql (class-name class) name))
+        (apply #'ensure-class-using-class class name all-keys)
+        (apply #'ensure-class-using-class nil name all-keys))))
 
 ;;; AMOP pg. 183ff.
 (defgeneric ensure-class-using-class (class name &key direct-default-initargs