From f8f1ca8ef2e4d5daee1f43cd6c8a0f18fec955ba Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 17 Feb 2008 15:48:50 +0100 Subject: Add a class definition test to the test suite. darcs-hash:d6774028b28a45e5983c6100e2dc44b8eccb2dcf --- Lisp/tests.lisp | 45 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) (limited to 'Lisp') diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 96d15a9..8c17ef5 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -24,7 +24,7 @@ #:inout #:const #:parse-typespec #:objective-c-class #:bit-field #:opaque #:bycopy #:byref #:primitive-invoke #:print-typespec-to-string - #:nominally)) + #:nominally #:find-objc-meta-class)) (in-package #:mulk.objective-cl.tests) (in-root-suite) @@ -345,3 +345,46 @@ :with-object (invoke (find-objc-class 'ns-object) 'self))))) + + +(defvar *class-counter* 0) + + +(deftest class-definition () + ;; FIXME: This test is broken. + ;; + ;; Reason: + ;; + ;; OBJECTIVE-CL> (invoke-by-name + ;; (invoke # 'reason) + ;; "UTF8String") + ;; "subclass MLKTestString0(instance) should override length" + ;; + (let ((class-name (intern (format nil "~A~D" + '#:mlk-test-string + (incf *class-counter*)))) + (class nil) + (instance nil)) + (setq class + (is (c2mop:ensure-class class-name + :direct-superclasses + (list (find-objc-class "NSString")) + :direct-slots '((:name foos + :type list + :initform nil + :initargs (:foos)) + (:name foo-count + :foreign-type (:int ()))) + :metaclass (find-objc-meta-class "NSObject")))) + (is (typep class 'objective-c-class)) + (setq instance (is (invoke class :string-with-u-t-f-8-string "Mulk."))) + #+nil (is (typep instance class)) + (is (objc-equal instance + (invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string "Mulk."))) + (setf (slot-value instance 'foos) '(a b c)) + (setf (slot-value instance 'foo-count) 3) + (is (equal (slot-value instance 'foos) + (slot-value (invoke instance 'self) 'foos))) + (is (equal (slot-value instance 'foo-count) + (slot-value (invoke instance 'self) 'foo-count))))) -- cgit v1.2.3