summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-20 19:11:42 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-20 19:11:42 +0100
commitc83595ccc398cd165a6c8dfa2344506e19dafbcd (patch)
treeaa4b0a8d2a312f83443bc9b52be558ba9de8aded
parentabc3f637fa3e90cf361dfb00b4af15d2fce61a26 (diff)
Assign the metaclasses of metaclasses correctly.
darcs-hash:e393681b86a1b90b8023281fea1cff5b8fa33a44
-rw-r--r--Lisp/class-definition.lisp2
-rw-r--r--Lisp/data-types.lisp7
-rw-r--r--Lisp/libobjcl.lisp6
3 files changed, 10 insertions, 5 deletions
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