diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-20 19:11:42 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-20 19:11:42 +0100 |
| commit | c83595ccc398cd165a6c8dfa2344506e19dafbcd (patch) | |
| tree | aa4b0a8d2a312f83443bc9b52be558ba9de8aded | |
| parent | abc3f637fa3e90cf361dfb00b4af15d2fce61a26 (diff) | |
Assign the metaclasses of metaclasses correctly.
darcs-hash:e393681b86a1b90b8023281fea1cff5b8fa33a44
| -rw-r--r-- | Lisp/class-definition.lisp | 2 | ||||
| -rw-r--r-- | Lisp/data-types.lisp | 7 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 6 |
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 |