diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-12 19:41:02 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-12 19:41:02 +0200 |
commit | 048c5db4f7a732376f0a4526502e012a0f29e0c7 (patch) | |
tree | 69a9bf3e80fd9e633cfeaf925e4ab5379bed21d2 /Lisp | |
parent | dac89d30fa1e9eabcde3d522a6c5ca0471cce3b1 (diff) |
Code cleanup, fix a couple of memory leaks.
darcs-hash:629e2764a4ce319c9a7d9bc3a22e6f254633c73f
Diffstat (limited to 'Lisp')
-rw-r--r-- | Lisp/method-invocation.lisp | 63 | ||||
-rw-r--r-- | Lisp/tests.lisp | 18 | ||||
-rw-r--r-- | 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))))) |