summaryrefslogtreecommitdiff
path: root/Lisp/tests.lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-08-07 18:26:48 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-08-07 18:26:48 +0200
commitdac89d30fa1e9eabcde3d522a6c5ca0471cce3b1 (patch)
tree1cb2d6399245e2b314e27b336a19f6ecb2aebf33 /Lisp/tests.lisp
parentcfb36ab13d53f2d9134ff6d1a3569eb8d192940b (diff)
Write some test cases.
darcs-hash:83e718533f740f40f3e28edcf46436254a5010f6
Diffstat (limited to 'Lisp/tests.lisp')
-rw-r--r--Lisp/tests.lisp92
1 files changed, 87 insertions, 5 deletions
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 5a06963..0cc7379 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -1,9 +1,16 @@
(defpackage #:mulk.objective-cl.tests
- (:use #:lift #:mulk.objective-cl #:cl))
+ (:nicknames #:objcl-tests #:objective-cl-tests #:mulk.objcl-tests)
+ (:use #:lift #:mulk.objective-cl #:cl)
+ (:export #:run-all-tests))
(in-package #:mulk.objective-cl.tests)
+(eval-when (:compile-toplevel)
+ (objcl:install-reader-syntax))
+
+
(defun run-all-tests ()
+ (objcl:initialise-runtime)
(run-tests :suite 'objective-cl))
@@ -11,10 +18,85 @@
())
+(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-null (find-selector "mulkyStuff:withMagic:")))
+ ((ensure-same (find-selector "self")
+ (find-selector '(self))))
+ ((ensure-same (find-selector "stringWithCString:")
+ (find-selector '(:string-with-c-string))))
+ ((ensure-same (find-selector "stringWithCString:encoding:")
+ (find-selector '(:string-with-c-string :encoding))))))
+
+
(deftestsuite method-invocation (objective-cl)
()
- (:equality-test #'equal)
+ (: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 stringWithCString: "Mulk."]
+ [NSString stringWithCString: "Mulk."]))
+ ((ensure-different [NSString stringWithCString: "Mulk."]
+ [NSString stringWithCString: "Klum."]))
+ ((ensure [NSString isSubclassOfClass: [NSObject class]]))
+ ((ensure [NSString performSelector:
+ (find-selector "isSubclassOfClass:")
+ withObject: [NSObject class]]))))
+
+
+(deftestsuite data-coercion (objective-cl)
+ ()
+ (:equality-test #'objc-equal)
+ (:tests
+ ((ensure-same [NSString stringWithCString: "Mulk."]
+ [NSString stringWithCString: "Mulk." encoding: 4]))
+ ((ensure-same [NSString respondsToSelector: (find-selector "new")]
+ [NSString respondsToSelector: 'new]))
+ ((ensure-same [NSString respondsToSelector: (find-selector "new")]
+ [NSString respondsToSelector: "new"]))
+ ((ensure (typep [NSString isEqual: [NSString self]] 'boolean)))
+ ((ensure (typep [NSString isEqual: [NSObject self]] 'boolean)))))
+
+
+(deftestsuite exception-handling (objective-cl)
+ ()
+ (:equality-test #'objc-equal)
+ (:tests
+ ((ensure (typep (handler-case
+ [NSString selph]
+ (exception (e) e))
+ 'exception)))))
+
+
+(deftestsuite reader-syntax (objective-cl)
+ ()
+ (:equality-test #'objc-equal)
(:tests
- ((ensure (functionp (fn #'+ _ 10))))
- ((ensure-same (mapcar (fn (cons _ _)) '(1 2 3))
- '((1 . 1) (2 . 2) (3 . 3))))))
+ ((ensure-same [NSObject self]
+ (find-objc-class 'ns-object)))
+ ((ensure-same [NSString stringWithCString: "Mulk."]
+ (invoke (find-objc-class 'ns-string)
+ :string-with-c-string "Mulk.")))
+ ((ensure-same [NSString stringWithCString: "Mulk." encoding: 4]
+ (invoke (find-objc-class 'ns-string)
+ :string-with-c-string "Mulk." :encoding 4)))
+ ((ensure-same [NSString performSelector:
+ (find-selector "isSubclassOfClass:")
+ withObject: [NSObject class]]
+ (invoke (find-objc-class 'ns-string)
+ :performSelector (find-selector "isSubclassOfClass")
+ :with-object (find-objc-class 'ns-object))))))