From 319cdb79ca6ca45c9b2912ead651dffcf35ecbf5 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Sun, 16 Sep 2007 01:21:31 +0200
Subject: Add test cases for PRIMITIVE-INVOKE and fix some stupid bugs.

darcs-hash:d1f3e7e599cad38b28c45448adeec9126d043e05
---
 Lisp/libobjcl.lisp          |  2 +-
 Lisp/method-invocation.lisp |  6 ++----
 Lisp/tests.lisp             | 42 +++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 44 insertions(+), 6 deletions(-)

(limited to 'Lisp')

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)
-- 
cgit v1.2.3