diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/tests.lisp | 606 |
1 files changed, 285 insertions, 321 deletions
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 941e95b..0e56866 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -17,7 +17,7 @@ (defpackage #:mulk.objective-cl.tests (:nicknames #:objcl-tests #:objective-cl-tests #:mulk.objcl-tests) - (:use #:lift #:mulk.objective-cl #:cl) + (:use #:stefil #:mulk.objective-cl #:cl) (:export #:run-all-tests) (:shadowing-import-from #:objcl #:struct #:union #:pointer #:oneway #:out #:in @@ -25,6 +25,7 @@ #:bit-field #:opaque #:bycopy #:byref #:primitive-invoke #:print-typespec-to-string)) (in-package #:mulk.objective-cl.tests) +(in-root-suite) (eval-when (:compile-toplevel) @@ -32,351 +33,314 @@ (defun run-all-tests () - (objcl:initialise-runtime) - (run-tests :suite 'objective-cl)) - - -(deftestsuite objective-cl () - ()) + (objective-cl)) -(defrandom-instance double objective-cl - (if (zerop (random 2)) - (random most-positive-double-float) - (- (random (abs most-negative-double-float))))) +(defsuite objective-cl () + (objcl:initialise-runtime) + (run-child-tests) + (objcl:shutdown-runtime)) +(in-suite objective-cl) #.(prog1 nil (defparameter *readtable-backup* *readtable*) (setq *readtable* (copy-readtable)) (setf (readtable-case *readtable*) :invert)) -(deftestsuite base-functions (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure-same (find-objc-class 'ns-object) - (find-objc-class "NSObject"))) - ((ensure-null (find-objc-class 'nsobject))) - ((ensure-same (find-objc-class 'ns-method-invocation) - (find-objc-class "NSMethodInvocation"))) - ((ensure (typep (find-selector "mulkyStuff:withMagic:" nil) - '(or null selector)))) - ((ensure-same (find-selector "self") - (find-selector '(self)))) - ((ensure-same (find-selector "stringWithUTF8String:") - (find-selector '(:string-with-u-t-f-8-string)))) - ((ensure-same (find-selector "stringWithCString:encoding:") - (find-selector '(:string-with-c-string :encoding)))) - ;; Case-sensitivity. - ((ensure-same (find-selector "stringWithCString:encoding:") - (find-selector '(:stringWithCString :encoding)))) - ((ensure-same (find-selector "stringWithUTF8String:") - (find-selector :stringWithUTF8String))))) +(deftest base-functions () + (is (objc-equal (find-objc-class 'ns-object) + (find-objc-class "NSObject"))) + (is (null (find-objc-class 'nsobject))) + (is (objc-equal (find-objc-class 'ns-method-invocation) + (find-objc-class "NSMethodInvocation"))) + (is (typep (find-selector "mulkyStuff:withMagic:" nil) + '(or null selector))) + (is (objc-equal (find-selector "self") + (find-selector '(self)))) + (is (objc-equal (find-selector "stringWithUTF8String:") + (find-selector '(:string-with-u-t-f-8-string)))) + (is (objc-equal (find-selector "stringWithCString:encoding:") + (find-selector '(:string-with-c-string :encoding)))) + ;; Case-sensitivity. + (is (objc-equal (find-selector "stringWithCString:encoding:") + (find-selector '(:stringWithCString :encoding)))) + (is (objc-equal (find-selector "stringWithUTF8String:") + (find-selector :stringWithUTF8String)))) #.(prog1 nil (setq *readtable* *readtable-backup*)) -(deftestsuite primitive-method-invocation (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - (#+(or) (ensure-error (primitive-invoke (find-objc-class 'ns-object) - 'string 'id))) - ((ensure-error (primitive-invoke 300 'self 'id))) - ((ensure-error (primitive-invoke "abc" 'self 'id))) - (#+(or) (ensure-error (primitive-invoke (find-objc-class 'ns-object) - 'selph 'id))) - ((ensure-same (primitive-invoke (find-objc-class 'ns-object) - 'self 'id) - (primitive-invoke (find-objc-class 'ns-object) - 'class 'objective-c-class))) - ((ensure-different (primitive-invoke (find-objc-class 'ns-object) - 'self 'id) - (primitive-invoke (find-objc-class 'ns-number) - 'self 'id))) - ((ensure-same (primitive-invoke (find-objc-class 'ns-string) - :string-with-u-t-f-8-string 'id - "Mulk.") - (primitive-invoke (find-objc-class 'ns-string) - :string-with-u-t-f-8-string 'id - "Mulk."))) - ((ensure-different (primitive-invoke (find-objc-class 'ns-string) - :string-with-u-t-f-8-string 'id - "Mulk.") - (primitive-invoke (find-objc-class 'ns-string) - :string-with-u-t-f-8-string 'id - "Klum."))) - ((ensure (primitive-invoke (find-objc-class 'ns-string) - :is-subclass-of-class - (first (parse-typespec "c" t)) - (find-objc-class 'ns-object)))) - ;; performSelector:withObject: cannot be used with non-id return - ;; types. - #+(or) - ((ensure (primitive-invoke (find-objc-class 'ns-string) - '(:perform-selector :with-object) :char - (selector "isSubclassOfClass:") - (find-objc-class 'ns-object)))))) +(deftest primitive-method-invocation () + (#+(or) (signals error (primitive-invoke (find-objc-class 'ns-object) + 'string 'id))) + (signals error (primitive-invoke 300 'self 'id)) + (signals error (primitive-invoke "abc" 'self 'id)) + (#+(or) (signals error (primitive-invoke (find-objc-class 'ns-object) + 'selph 'id))) + (is (objc-equal (primitive-invoke (find-objc-class 'ns-object) + 'self 'id) + (primitive-invoke (find-objc-class 'ns-object) + 'class 'objective-c-class))) + (is (not (objc-equal (primitive-invoke (find-objc-class 'ns-object) + 'self 'id) + (primitive-invoke (find-objc-class 'ns-number) + 'self 'id)))) + (is (objc-equal (primitive-invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string 'id + "Mulk.") + (primitive-invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string 'id + "Mulk."))) + (is (not (objc-equal (primitive-invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string 'id + "Mulk.") + (primitive-invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string 'id + "Klum.")))) + (is (primitive-invoke (find-objc-class 'ns-string) + :is-subclass-of-class + (first (parse-typespec "c" t)) + (find-objc-class 'ns-object))) + ;; performSelector:withObject: cannot be used with non-id return + ;; types. + #+(or) + (is (primitive-invoke (find-objc-class 'ns-string) + '(:perform-selector :with-object) :char + (selector "isSubclassOfClass:") + (find-objc-class 'ns-object)))) -(deftestsuite method-invocation (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure-error [NSObject 300])) - ((ensure-error [300 self])) - ((ensure-error ["abc" self])) - ((ensure-error [NSObject selph])) - ((ensure-same [NSObject self] - [NSObject class])) - ((ensure-different [NSObject self] - [NSNumber self])) - ((ensure-same [NSString stringWithUTF8String: "Mulk."] - [NSString stringWithUTF8String: "Mulk."])) - ((ensure-different [NSString stringWithUTF8String: "Mulk."] - [NSString stringWithUTF8String: "Klum."])) - ((ensure [NSString isSubclassOfClass: [NSObject class]])) - ;; performSelector:withObject: cannot be used with non-id return - ;; types. - #+(or) - ((ensure [NSString performSelector: - (selector "stringWithUTF8String:") - withObject: [NSObject class]])))) +(deftest method-invocation () + (signals error [NSObject 300]) + (signals error [300 self]) + (signals error ["abc" self]) + (signals error [NSObject selph]) + (is (objc-equal [NSObject self] + [NSObject class])) + (is (not (objc-equal [NSObject self] + [NSNumber self]))) + (is (objc-equal [NSString stringWithUTF8String: "Mulk."] + [NSString stringWithUTF8String: "Mulk."])) + (is (not (objc-equal [NSString stringWithUTF8String: "Mulk."] + [NSString stringWithUTF8String: "Klum."]))) + (is [NSString isSubclassOfClass: [NSObject class]]) + ;; performSelector:withObject: cannot be used with non-id return + ;; types. + #+(or) + (is [NSString performSelector: (selector "stringWithUTF8String:") + withObject: [NSObject class]])) -(deftestsuite parsing-typespecs (objective-cl) - () - (:equality-test #'equal) - (:tests - ((ensure-same (parse-typespec "@0:4{_NSRange=II}8") - '(id ()))) - ((ensure-same (parse-typespec ":4{_NSRange=II}8") - '(selector ()))) - ((ensure-same (parse-typespec "{_NSRange=II}8") - '(struct () "_NSRange" - (:unsigned-int ()) - (:unsigned-int ())))) - ((ensure-same (parse-typespec "rnNoV^V[10rjd]4") - ;; Actually, the order of the qualifiers doesn't - ;; matter, which means that this test is dumber than - ;; it ought to be. - '(pointer (oneway out inout in const) - (array (oneway) - 10 - (complex (const) (:double nil)))))) - ((ensure-same (parse-typespec "ROi") - ;; Here, too, the order of the qualifiers is irrelevant. - '(:int (bycopy byref)))) - ((ensure-same (parse-typespec "(?=)") - '(union () "?"))) - ((ensure-same (parse-typespec "{?=rb123rjf456iii}") - (if (eq objcl::+runtime-type+ :gnu) - '(struct () "?" - (bit-field (const) 123 456 - (complex (const) (:float ()))) - (:int ()) - (:int ()) - (:int ())) - '(struct () "?" - (bit-field (const) nil 123 nil) - (complex (const) (:float ())) - (:unrecognised ((:type-specifier #\4))) - (:unrecognised ((:type-specifier #\5))) - (:unrecognised ((:type-specifier #\6))) - (:int ()) - (:int ()) - (:int ()))))) - ((ensure-same (parse-typespec "^[100{?=ii}]") - '(pointer () - (array () 100 - (struct () "?" (:int ()) (:int ())))))) - ((ensure-same (parse-typespec "{?=BiIlLqQfd@#:*?}") +(deftest parsing-typespecs () + (is (equal (parse-typespec "@0:4{_NSRange=II}8") + '(id ()))) + (is (equal (parse-typespec ":4{_NSRange=II}8") + '(selector ()))) + (is (equal (parse-typespec "{_NSRange=II}8") + '(struct () "_NSRange" + (:unsigned-int ()) + (:unsigned-int ())))) + (is (equal (parse-typespec "rnNoV^V[10rjd]4") + ;; Actually, the order of the qualifiers doesn't + ;; matter, which means that this test is dumber than + ;; it ought to be. + '(pointer (oneway out inout in const) + (array (oneway) + 10 + (complex (const) (:double nil)))))) + (is (equal (parse-typespec "ROi") + ;; Here, too, the order of the qualifiers is irrelevant. + '(:int (bycopy byref)))) + (is (equal (parse-typespec "(?=)") + '(union () "?"))) + (is (equal (parse-typespec "{?=rb123rjf456iii}") + (if (eq objcl::+runtime-type+ :gnu) + '(struct () "?" + (bit-field (const) 123 456 + (complex (const) (:float ()))) + (:int ()) + (:int ()) + (:int ())) '(struct () "?" - (:boolean ()) + (bit-field (const) nil 123 nil) + (complex (const) (:float ())) + (:unrecognised ((:type-specifier #\4))) + (:unrecognised ((:type-specifier #\5))) + (:unrecognised ((:type-specifier #\6))) + (:int ()) + (:int ()) + (:int ()))))) + (is (equal (parse-typespec "^[100{?=ii}]") + '(pointer () + (array () 100 + (struct () "?" (:int ()) (:int ())))))) + (is (equal (parse-typespec "{?=BiIlLqQfd@#:*?}") + '(struct () "?" + (:boolean ()) + (:int ()) + (:unsigned-int ()) + (:long ()) + (:unsigned-long ()) + (:long-long ()) + (:unsigned-long-long ()) + (:float ()) + (:double ()) + (id ()) (objective-c-class ()) (selector ()) + (:string ()) + (:unknown ())))) + (let ((funky-spec (parse-typespec "{?=cC}"))) + (is (member funky-spec + '((struct () "?" + (:char ()) + (:unsigned-char ())) + (struct () "?" + (:int ()) + (:unsigned-int ()))) + :test #'equalp))) + (let ((funky-spec (parse-typespec "{?=sS}"))) + (is (member funky-spec + '((struct () "?" + (:short ()) + (:unsigned-short ())) + (struct () "?" (:int ()) - (:unsigned-int ()) - (:long ()) - (:unsigned-long ()) - (:long-long ()) - (:unsigned-long-long ()) - (:float ()) - (:double ()) - (id ()) (objective-c-class ()) (selector ()) - (:string ()) - (:unknown ())))) - ((ensure (let ((funky-spec (parse-typespec "{?=cC}"))) - (member funky-spec - '((struct () "?" - (:char ()) - (:unsigned-char ())) - (struct () "?" - (:int ()) - (:unsigned-int ()))) - :test #'equalp)))) - ((ensure (let ((funky-spec (parse-typespec "{?=sS}"))) - (member funky-spec - '((struct () "?" - (:short ()) - (:unsigned-short ())) - (struct () "?" - (:int ()) - (:unsigned-int ()))) - :test #'equalp)))) - ((ensure-same (parse-typespec "{Mulk=*{Untermulk={Unteruntermulk=}}i}") - '(struct () "Mulk" - (:string ()) - (struct () "Untermulk" - (struct () "Unteruntermulk")) - (:int ())))) - ((ensure-same (parse-typespec "^^{OpaqueStruct}") - '(pointer () - (pointer () - (struct (opaque) "OpaqueStruct"))))))) + (:unsigned-int ()))) + :test #'equalp))) + (is (equal (parse-typespec "{Mulk=*{Untermulk={Unteruntermulk=}}i}") + '(struct () "Mulk" + (:string ()) + (struct () "Untermulk" + (struct () "Unteruntermulk")) + (:int ())))) + (is (equal (parse-typespec "^^{OpaqueStruct}") + '(pointer () + (pointer () + (struct (opaque) "OpaqueStruct")))))) -(deftestsuite printing-typespecs (objective-cl) - () - (:equality-test #'equal) - (:tests - ((ensure-same (print-typespec-to-string '(id ())) - "@")) - ((ensure-same (print-typespec-to-string '(selector ())) - ":")) - ((ensure-same (print-typespec-to-string '(struct () "_NSRange" - (:unsigned-int ()) - (:unsigned-int ()))) - "{_NSRange=II}")) - ((ensure-same (print-typespec-to-string '(pointer (oneway out inout in const) - (array (oneway) - 10 - (complex (const) (:double nil))))) - ;; Actually, the order of the qualifiers doesn't - ;; matter, which means that this test is dumber than - ;; it ought to be. - "VoNnr^V[10rjd]")) - ((ensure-same (print-typespec-to-string '(:int (bycopy byref))) - ;; Here, too, the order of the qualifiers is irrelevant. - "ORi")) - ((ensure-same (print-typespec-to-string '(union () "?")) - "(?=)")) - ((ensure-same (print-typespec-to-string - (if (eq objcl::+runtime-type+ :gnu) - '(struct () "?" - (bit-field (const) 123 456 - (complex (const) (:float ()))) - (:int ()) - (:int ()) - (:int ())) - '(struct () "?" - (bit-field (const) nil 123 nil) - (complex (const) (:float ())) - (:unrecognised ((:type-specifier #\4))) - (:unrecognised ((:type-specifier #\5))) - (:unrecognised ((:type-specifier #\6))) - (:int ()) - (:int ()) - (:int ())))) - "{?=rb123rjf456iii}")) - ((ensure-same (print-typespec-to-string '(pointer () - (array () 100 - (struct () "?" (:int ()) (:int ()))))) - "^[100{?=ii}]")) - ((ensure-same (print-typespec-to-string '(struct () "?" - (:boolean ()) - (:int ()) - (:unsigned-int ()) - (:long ()) - (:unsigned-long ()) - (:long-long ()) - (:unsigned-long-long ()) - (:float ()) - (:double ()) - (id ()) (objective-c-class ()) (selector ()) - (:string ()) - (:unknown ()))) - "{?=BiIlLqQfd@#:*?}")) - ((ensure-same (print-typespec-to-string '(struct () "?" - (:char ()) - (:unsigned-char ()))) - "{?=cC}")) - ((ensure-same (print-typespec-to-string '(struct () "?" - (:short ()) - (:unsigned-short ()))) - "{?=sS}")) - ((ensure-same (print-typespec-to-string - '(struct () "Mulk" - (:string ()) - (struct () "Untermulk" - (struct () "Unteruntermulk")) - (:int ()))) - "{Mulk=*{Untermulk={Unteruntermulk=}}i}")) - ((ensure-same (print-typespec-to-string - '(pointer () - (pointer () - (struct (opaque) "OpaqueStruct")))) - "^^{OpaqueStruct}")))) +(deftest printing-typespecs () + (is (equal (print-typespec-to-string '(id ())) + "@")) + (is (equal (print-typespec-to-string '(selector ())) + ":")) + (is (equal (print-typespec-to-string '(struct () "_NSRange" + (:unsigned-int ()) + (:unsigned-int ()))) + "{_NSRange=II}")) + (is (equal (print-typespec-to-string '(pointer (oneway out inout in const) + (array (oneway) + 10 + (complex (const) (:double nil))))) + ;; Actually, the order of the qualifiers doesn't + ;; matter, which means that this test is dumber than + ;; it ought to be. + "VoNnr^V[10rjd]")) + (is (equal (print-typespec-to-string '(:int (bycopy byref))) + ;; Here, too, the order of the qualifiers is irrelevant. + "ORi")) + (is (equal (print-typespec-to-string '(union () "?")) + "(?=)")) + (is (equal (print-typespec-to-string + (if (eq objcl::+runtime-type+ :gnu) + '(struct () "?" + (bit-field (const) 123 456 + (complex (const) (:float ()))) + (:int ()) + (:int ()) + (:int ())) + '(struct () "?" + (bit-field (const) nil 123 nil) + (complex (const) (:float ())) + (:unrecognised ((:type-specifier #\4))) + (:unrecognised ((:type-specifier #\5))) + (:unrecognised ((:type-specifier #\6))) + (:int ()) + (:int ()) + (:int ())))) + "{?=rb123rjf456iii}")) + (is (equal (print-typespec-to-string '(pointer () + (array () 100 + (struct () "?" (:int ()) (:int ()))))) + "^[100{?=ii}]")) + (is (equal (print-typespec-to-string '(struct () "?" + (:boolean ()) + (:int ()) + (:unsigned-int ()) + (:long ()) + (:unsigned-long ()) + (:long-long ()) + (:unsigned-long-long ()) + (:float ()) + (:double ()) + (id ()) (objective-c-class ()) (selector ()) + (:string ()) + (:unknown ()))) + "{?=BiIlLqQfd@#:*?}")) + (is (equal (print-typespec-to-string '(struct () "?" + (:char ()) + (:unsigned-char ()))) + "{?=cC}")) + (is (equal (print-typespec-to-string '(struct () "?" + (:short ()) + (:unsigned-short ()))) + "{?=sS}")) + (is (equal (print-typespec-to-string + '(struct () "Mulk" + (:string ()) + (struct () "Untermulk" + (struct () "Unteruntermulk")) + (:int ()))) + "{Mulk=*{Untermulk={Unteruntermulk=}}i}")) + (is (equal (print-typespec-to-string + '(pointer () + (pointer () + (struct (opaque) "OpaqueStruct")))) + "^^{OpaqueStruct}"))) -(deftestsuite data-coercion (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure-same [NSString stringWithUTF8String: "Mulk."] - [NSString stringWithCString: "Mulk." encoding: 4])) - ((ensure-same [NSString respondsToSelector: (selector "new")] - [NSString respondsToSelector: 'new])) - ((ensure-same [NSString respondsToSelector: (selector "new")] - [NSString respondsToSelector: "new"])) - ((ensure (typep [NSString isEqual: [NSString self]] 'boolean))) - ((ensure (typep [NSString isEqual: [NSObject self]] 'boolean))))) +(deftest data-coercion () + (is (objc-equal [NSString stringWithUTF8String: "Mulk."] + [NSString stringWithCString: "Mulk." encoding: 4])) + (is (objc-equal [NSString respondsToSelector: (selector "new")] + [NSString respondsToSelector: 'new])) + (is (objc-equal [NSString respondsToSelector: (selector "new")] + [NSString respondsToSelector: "new"])) + (is (typep [NSString isEqual: [NSString self]] 'boolean)) + (is (typep [NSString isEqual: [NSObject self]] 'boolean))) -(deftestsuite numbers (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure-same [[NSDecimalNumber - decimalNumberWithString: - [NSString stringWithUTF8String: - "-12345"]] - doubleValue] - -12345d0)))) +(deftest numbers () + (is (objc-equal [[NSDecimalNumber decimalNumberWithString: + [NSString stringWithUTF8String: "-12345"]] + doubleValue] + -12345d0))) -(deftestsuite exception-handling (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure (typep (handler-case - [NSString selph] - (error (e) e)) - '(or no-such-selector message-not-understood)))) - ((ensure (typep (handler-case - [NSObject string] - (error (e) e)) - 'message-not-understood))))) +(deftest exception-handling () + (is (typep (handler-case [NSString selph] + (error (e) e)) + '(or no-such-selector message-not-understood))) + (is (typep (handler-case [NSObject string] + (error (e) e)) + 'message-not-understood))) -(deftestsuite reader-syntax (objective-cl) - () - (:equality-test #'objc-equal) - (:tests - ((ensure-same [NSObject self] - (find-objc-class 'ns-object))) - ((ensure-same [NSString stringWithUTF8String: "Mulk."] - (invoke (find-objc-class 'ns-string) - :string-with-u-t-f-8-string "Mulk."))) - ((ensure-same [NSString stringWithCString: "Mulk." encoding: 4] - (invoke (find-objc-class 'ns-string) - :string-with-c-string "Mulk." :encoding 4))) - ;; performSelector:withObject: cannot be used with non-id return - ;; types. - #+(or) - ((ensure-same [NSString performSelector: - (selector "isSubclassOfClass:") - withObject: [NSObject self]] - (invoke (find-objc-class 'ns-string) - :perform-selector (selector "isSubclassOfClass:") - :with-object (invoke - (find-objc-class 'ns-object) - 'self)))))) +(deftest reader-syntax () + (is (objc-equal [NSObject self] + (find-objc-class 'ns-object))) + (is (objc-equal [NSString stringWithUTF8String: "Mulk."] + (invoke (find-objc-class 'ns-string) + :string-with-u-t-f-8-string "Mulk."))) + (is (objc-equal [NSString stringWithCString: "Mulk." encoding: 4] + (invoke (find-objc-class 'ns-string) + :string-with-c-string "Mulk." :encoding 4))) + ;; performSelector:withObject: cannot be used with non-id return + ;; types. + #+(or) + (is (objc-equal [NSString performSelector: (selector "isSubclassOfClass:") + withObject: [NSObject self]] + (invoke (find-objc-class 'ns-string) + :perform-selector (selector "isSubclassOfClass:") + :with-object (invoke + (find-objc-class 'ns-object) + 'self))))) |