From cb2858af09521a572ba8d222f1d1b21324ab6f44 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 4 Mar 2008 16:59:42 +0100
Subject: Acquire the exception lock when returning from a callback.

darcs-hash:f644e3e364ebb7bd2c81aa2c7f83a4887ac644d8
---
 Lisp/libobjcl.lisp          |  4 ++--
 Lisp/method-definition.lisp | 10 ++++++----
 Lisp/tests.lisp             |  2 +-
 3 files changed, 9 insertions(+), 7 deletions(-)

(limited to 'Lisp')

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