diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-04 16:59:42 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-04 16:59:42 +0100 |
| commit | cb2858af09521a572ba8d222f1d1b21324ab6f44 (patch) | |
| tree | f421a09b9b65189b1d314567c72d9e00c9b56b68 /Lisp | |
| parent | 3bb7048d77f9e3888d4cf8d2cfa742b6956d3f7c (diff) | |
Acquire the exception lock when returning from a callback.
darcs-hash:f644e3e364ebb7bd2c81aa2c7f83a4887ac644d8
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/libobjcl.lisp | 4 | ||||
| -rw-r--r-- | Lisp/method-definition.lisp | 10 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 2 |
3 files changed, 9 insertions, 7 deletions
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index d8e8b07..d038c62 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -145,10 +145,10 @@ (return-typespec :string) (arg-typespecs (:array :string))) -(defcfun ("objcl_acquire_lock" %objcl-release-lock) :pointer +(defcfun ("objcl_acquire_lock" %objcl-acquire-lock) :pointer (lock :pointer)) -(defcfun ("objcl_release_lock" %objcl-acquire-lock) :pointer +(defcfun ("objcl_release_lock" %objcl-release-lock) :pointer (lock :pointer)) (defcfun ("objcl_create_class" %objcl-create-class) :pointer diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp index 0b41898..6df7feb 100644 --- a/Lisp/method-definition.lisp +++ b/Lisp/method-definition.lisp @@ -126,10 +126,12 @@ (print '(,(generic-function-name gf) ,@arguments)) (format t "~&~A" (list ,@arg-symbols))) - (,(generic-function-name gf) - ;; Leave the second argument (the - ;; selector) out. - ,@(list* (car arguments) (cddr arguments))))))) + (unwind-protect + (,(generic-function-name gf) + ;; Leave the second argument (the + ;; selector) out. + ,@(list* (car arguments) (cddr arguments))) + (%objcl-acquire-lock *objcl-current-exception-lock*)))))) (let ((callback (get-callback callback-name))) (with-foreign-object (arg-typestring-buffer :string (- (length arg-typestrings) 2)) diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 42ba3fe..c2ba1d6 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -435,7 +435,7 @@ (b ns::ns-number) &rest rest) (declare (ignore z rest)) - (+ y 150)))) + (+ y 20)))) ;; Sanity checks. (is (typep class 'objective-c-class)) |