From c83595ccc398cd165a6c8dfa2344506e19dafbcd Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 20 Feb 2008 19:11:42 +0100
Subject: Assign the metaclasses of metaclasses correctly.

darcs-hash:e393681b86a1b90b8023281fea1cff5b8fa33a44
---
 Lisp/class-definition.lisp | 2 +-
 Lisp/data-types.lisp       | 7 ++++++-
 Lisp/libobjcl.lisp         | 6 +++---
 3 files changed, 10 insertions(+), 5 deletions(-)

(limited to 'Lisp')

diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 51bb12d..9256112 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -103,7 +103,7 @@
             :writers (or writers nil)
             :initargs (or initargs nil)
             :initform (or initform *objcl-foreign-default-initform*)
-            :location nil
+            ;;? :location nil
             :allocation (or allocation :instance)
             :initfunction (or initfunction
                               #'(lambda ()
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 3de1185..432091a 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -170,7 +170,12 @@ a suitable class method instead as you would in Objective-C.
                  "Whether the class has been registered with the Objective-C runtime.")))
 
 
-(defclass objective-c-meta-class (objective-c-class) ())
+(defclass objective-c-meta-class (objective-c-class)
+     ((fake-p :type boolean
+              :initform nil
+              :initarg :fake-p
+              :accessor metaclass-fake-p
+              :documentation "Whether the class is a fake metaclass.")))
 
 
 (define-condition exception (error)
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index e6b1b9a..f13d298 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -419,8 +419,7 @@ conventional case for namespace identifiers in Objective-C."
                ;; our own, which will always get us the root metaclass.
                (metaclass
                 (if non-meta-superclass
-                    (if (typep (class-of superclass)
-                               'objective-c-meta-class)
+                    (if (metaclass-fake-p (class-of superclass))
                         superclass
                         (class-of superclass))
                     (let ((fake-metaclass-name
@@ -429,7 +428,8 @@ conventional case for namespace identifiers in Objective-C."
                           (c2mop:ensure-class fake-metaclass-name
                                               :metaclass 'objective-c-meta-class
                                               :pointer class-ptr
-                                              :direct-superclasses (list superclass)))))))
+                                              :direct-superclasses (list superclass)
+                                              :fake-p t))))))
           (or (find-class class-name nil)
               (c2mop:ensure-class class-name
                                   :metaclass metaclass
-- 
cgit v1.2.3