From 048c5db4f7a732376f0a4526502e012a0f29e0c7 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Sun, 12 Aug 2007 19:41:02 +0200
Subject: Code cleanup, fix a couple of memory leaks.

darcs-hash:629e2764a4ce319c9a7d9bc3a22e6f254633c73f
---
 Lisp/method-invocation.lisp | 63 +++++++++++++++++----------------------------
 Lisp/tests.lisp             | 18 +++++++++++++
 Lisp/type-conversion.lisp   |  4 +--
 3 files changed, 44 insertions(+), 41 deletions(-)

diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 4de8dc6..95784fa 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -121,45 +121,30 @@ Returns: *result* --- the return value of the method invocation.
 
   (check-type receiver (or id objc-class exception)
               "an Objective C instance (ID, OBJC-CLASS or EXCEPTION)")
-  (let* ((arglist (arglist-intersperse-types
-                   (mapcar #'lisp->obj-data args)))
-         (return-value (apply-macro '%objcl-invoke-method
-                                    (lisp->obj-data receiver)
-                                    method-name
-                                    (length args)
-                                    arglist)))
-    (when *trace-method-calls*
-      (format t "~&Invoking [~A].~%" method-name))
-    (unwind-protect
-         (let ((value
-                (let ((*skip-retaining* (or *skip-retaining*
-                                            (constructor-name-p method-name))))
-                  (obj-data->lisp return-value))))
-           (if (typep value 'condition)
-               (cerror "Return NIL from OBJCL-INVOKE-METHOD" value)
-               value))
-      (dealloc-obj-data return-value))))
-
-
-#+nil
-(defun invoke-instance-method-by-name (receiver method-name &rest args)
-  (let* ((arglist (arglist-intersperse-types
-                   (mapcar #'lisp->obj-data args)))
-         (return-value (apply-macro '%objcl-invoke-instance-method
-                                    (lisp->obj-data receiver)
-                                    method-name
-                                    (length args)
-                                    arglist)))
-    (format t "~&Invoking <~A>.~%" method-name)
-    (unwind-protect
-         (let ((value
-                (let ((*skip-retaining* (or *skip-retaining*
-                                            (constructor-name-p method-name))))
-                  (obj-data->lisp return-value))))
-           (if (typep value 'condition)
-               (cerror "Return NIL from OBJCL-INVOKE-INSTANCE-METHOD" value)
-               value))
-      (dealloc-obj-data return-value))))
+  (when *trace-method-calls*
+    (format t "~&Invoking [~A].~%" method-name))
+  (flet ((convert/signal (foreign-value)
+           ;; Convert a foreign value into a Lisp value.  If the value
+           ;; to be converted represents an exception, signal it instead
+           ;; of returning it as a value.
+           (let ((lisp-value (obj-data->lisp foreign-value)))
+             (if (typep lisp-value 'condition)
+                 (cerror "Return NIL from OBJCL-INVOKE-METHOD." lisp-value)
+                 lisp-value))))
+    (let* ((objc-args (mapcar #'lisp->obj-data args))
+           (arglist (arglist-intersperse-types objc-args)))
+      (unwind-protect
+           (with-foreign-conversion ((objc-receiver receiver))
+             (with-foreign-objects ((return-value
+                                     (apply-macro '%objcl-invoke-method
+                                                  objc-receiver
+                                                  method-name
+                                                  (length args)
+                                                  arglist)))
+               (let ((*skip-retaining* (or *skip-retaining*
+                                           (constructor-name-p method-name))))
+                 (convert/signal return-value))))
+        (mapc #'dealloc-obj-data objc-args)))))
 
 
 ;;; (@* "Helper functions")
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 0cc7379..28c4c9f 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -18,6 +18,12 @@
   ())
 
 
+(defrandom-instance double objective-cl
+  (if (zerop (random 2))
+      (random most-positive-double-float)
+      (- (random (abs most-negative-double-float)))))
+
+
 (deftestsuite base-functions (objective-cl)
   ()
   (:equality-test #'objc-equal)
@@ -72,6 +78,18 @@
    ((ensure (typep [NSString isEqual: [NSObject self]] 'boolean)))))
 
 
+(deftestsuite numbers (objective-cl)
+  ()
+  (:equality-test #'objc-equal)
+  (:tests
+   ((ensure-same [[NSDecimalNumber
+                   decimalNumberWithString:
+                     [NSString stringWithCString:
+                        "-12345"]]
+                  doubleValue]
+                 -12345d0))))
+
+
 (deftestsuite exception-handling (objective-cl)
   ()
   (:equality-test #'objc-equal)
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index a11a668..bba40e7 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -12,7 +12,7 @@
             (typecase value
               ((or id objc-class selector exception)
                (pointer-to value))
-              (string    (foreign-string-alloc value))
+              (string (foreign-string-alloc value))
               (otherwise value)))
       (setf type
             (foreign-string-alloc (type-name->type-id type-name))))
@@ -31,7 +31,7 @@
       (case lisp-type
         ((id objc-class selector exception)
          (make-instance lisp-type :pointer value))
-        ((string)  (foreign-string-to-lisp value))
+        ((string) (foreign-string-to-lisp value))
         (otherwise value)))))
 
 
-- 
cgit v1.2.3