Fix Objective-C class registration.

darcs-hash:03e58bd27621a0bf46f05cc1ee733da1c7ab1170

2 files changed, 11 insertions, 2 deletions

diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index ff091a9..6ecb189 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -340,7 +340,7 @@
 (defmethod make-instance :before ((class objective-c-class)
                                   &key
                                   &allow-other-keys)
-  (unless (typep class 'objective-c-meta-class)
+  (unless (subtypep class 'objective-c-meta-class)
     (foreign-class-ensure-registered class)))
 
 
@@ -348,6 +348,7 @@
   (with-exclusive-access (class)
     (unless (foreign-class-registered-p class)
       (setf (foreign-class-registered-p class) t)
+      (%objcl-finalise-class (pointer-to (class-of class)))
       (%objcl-finalise-class (pointer-to class))))
   class)
 
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 443929e..d2d89c9 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -25,7 +25,8 @@
                           #:bit-field #:opaque #:bycopy #:byref
                           #:primitive-invoke #:print-typespec-to-string
                           #:nominally #:find-objc-meta-class
-                          #:objcl-object-backed-by-lisp-class-p))
+                          #:objcl-object-backed-by-lisp-class-p
+                          #:foreign-class-registered-p))
 (in-package #:mulk.objective-cl.tests)
 (in-root-suite)
 
@@ -368,10 +369,17 @@
                                                    :foreign-type (:int ())))
                                   :metaclass (find-objc-meta-class "NSObject"))))
 
+    ;; Class initialisation.
+    (is (not (foreign-class-registered-p class)))
+
     ;; Sanity checks.
     (is (typep class 'objective-c-class))
     (setq instance (is (invoke (invoke class 'alloc) 'init)))
 
+    ;; Class finalisation.  (Should be automatic upon instance
+    ;; creation.)
+    (is (foreign-class-registered-p class))
+
     ;; Object identity preservation.
     (is (eql instance
              (invoke instance 'self)))