diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-16 01:21:31 +0200 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-16 01:21:31 +0200 |
| commit | 319cdb79ca6ca45c9b2912ead651dffcf35ecbf5 (patch) | |
| tree | b2fd4e57953fb050316c74f818d23dff565b8b01 | |
| parent | 6a82b0dd5fd0f087ecda5923c6ae93fcea806141 (diff) | |
Add test cases for PRIMITIVE-INVOKE and fix some stupid bugs.
darcs-hash:d1f3e7e599cad38b28c45448adeec9126d043e05
| -rw-r--r-- | Lisp/libobjcl.lisp | 2 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 6 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 42 |
3 files changed, 44 insertions, 6 deletions
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 6cb9759..978bcfe 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -28,7 +28,7 @@ (defcfun ("objcl_invoke_method" %objcl-invoke-method) obj-data (receiver obj-data) - (method-selector obj-data) + (method-selector :pointer) (argc :int) &rest) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index c44fb04..41584ad 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -135,7 +135,7 @@ Returns: *result* --- the return value of the method invocation. (selector (selector method-name))) (unwind-protect (with-foreign-conversion ((objc-receiver receiver)) - (with-foreign-objects ((return-value + (with-obj-data-values ((return-value (apply-macro '%objcl-invoke-method objc-receiver (pointer-to selector) @@ -230,9 +230,7 @@ Returns: *result* --- the return value of the method invocation. (ad-hoc-arglist->objc-arglist! args) (unwind-protect (let ((error-cell - (%objcl-invoke-with-types (pointer-to receiver) - (pointer-to selector) - (length args) + (%objcl-invoke-with-types (length args) return-type-cell arg-types return-value-cell diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 38dd824..855860a 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -5,7 +5,8 @@ (:shadowing-import-from #:objcl #:struct #:union #:pointer #:oneway #:out #:in #:inout #:const #:parse-typespec #:objc-class - #:bit-field #:opaque #:bycopy #:byref)) + #:bit-field #:opaque #:bycopy #:byref + #:primitive-invoke)) (in-package #:mulk.objective-cl.tests) @@ -46,6 +47,45 @@ (find-selector '(:string-with-c-string :encoding)))))) +(deftestsuite primitive-method-invocation (objective-cl) + () + (:equality-test #'objc-equal) + (:tests + ((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))) + ((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 '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-c-string 'id + "Mulk.") + (primitive-invoke (find-objc-class 'ns-string) + :string-with-c-string 'id + "Mulk."))) + ((ensure-different (primitive-invoke (find-objc-class 'ns-string) + :string-with-c-string 'id + "Mulk.") + (primitive-invoke (find-objc-class 'ns-string) + :string-with-c-string 'id + "Klum."))) + ((ensure (primitive-invoke (find-objc-class 'ns-string) + :is-subclass-of-class :boolean + (find-objc-class 'ns-object)))) + ((ensure (primitive-invoke (find-objc-class 'ns-string) + '(:perform-selector :with-object) :boolean + (selector "isSubclassOfClass:") + (find-objc-class 'ns-object)))))) + + (deftestsuite method-invocation (objective-cl) () (:equality-test #'objc-equal) |