永井@知能.九工大です.

From: nobu.nakada / nifty.ne.jp
Subject: [ruby-dev:21865] Re: lib/test/unit/ui/tk/testrunner.rb
Date: Fri, 7 Nov 2003 11:42:15 +0900
Message-ID: <200311070242.hA72gEbd003000 / sharui.nakada.kanuma.tochigi.jp>
> スタックトレースによると、tclからコールバックされた(?)ip_ruby()
> からip_eval()が呼ばれて、再度tclを呼んで落ちているように見えま
> す。これが関係しているかどうか、分かりませんが。
   (snip)
> それはそうと、このmutexの解放とrb_trap_immediateの復帰は
> rb_ensure()かrb_protect()を使わないとまずいような気がします。

遅くなりましたが,これではどうでしょうか?

Index: tcltklib.c
===================================================================
RCS file: /src/ruby/ext/tcltklib/tcltklib.c,v
retrieving revision 1.45
diff -u -r1.45 tcltklib.c
--- tcltklib.c	29 Oct 2003 11:03:54 -0000	1.45
+++ tcltklib.c	7 Nov 2003 10:09:51 -0000
@@ -19,6 +19,11 @@
 #include <tcl.h>
 #include <tk.h>
 
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+#include <pthread.h>
+#include <errno.h>
+#endif
+
 #ifdef __MACOS__
 # include <tkMac.h>
 # include <Quickdraw.h>
@@ -79,6 +84,16 @@
     VALUE *result;
     VALUE thread;
 };
+
+struct eval_queue {
+    Tcl_Event ev;
+    VALUE str;
+    VALUE obj;
+    int done;
+    int safe_level;
+    VALUE *result;
+    VALUE thread;
+};
  
 static VALUE eventloop_thread;
 static VALUE watchdog_thread;
@@ -374,6 +389,11 @@
     return INT2FIX(Tk_GetNumMainWindows());
 }
 
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+pthread_mutex_t mtx_do_one_event = PTHREAD_MUTEX_INITIALIZER;
+pthread_t do_one_event_thid = -1;
+#endif
+
 static int
 lib_eventloop_core(check_root, check_var)
     int check_root;
@@ -382,6 +402,7 @@
     VALUE current = eventloop_thread;
     int found_event = 1;
     struct timeval t;
+    int recursive_lock = 0;
 
     t.tv_sec = (time_t)0;
     t.tv_usec = (time_t)(no_event_wait*1000.0);
@@ -413,7 +434,21 @@
 		}
 	    }
 
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+	    if (pthread_mutex_trylock(&mtx_do_one_event) == EBUSY) {
+		if (pthread_self() != do_one_event_thid) {
+		    pthread_mutex_lock(&mtx_do_one_event);
+		    do_one_event_thid = pthread_self();
+		}
+	    } else {
+		do_one_event_thid = pthread_self();
+	    }
+#endif
 	    found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+	    do_one_event_thid = -1;
+	    pthread_mutex_unlock(&mtx_do_one_event);
+#endif
 
 	    if (loop_counter++ > 30000) {
 		loop_counter = 0;
@@ -451,7 +486,23 @@
 		    }
 		}
 
-		if (Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)) {
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+		if (pthread_mutex_trylock(&mtx_do_one_event) == EBUSY) {
+		    if (pthread_self() != do_one_event_thid) {
+			pthread_mutex_lock(&mtx_do_one_event);
+			do_one_event_thid = pthread_self();
+		    }
+		} else {
+		    do_one_event_thid = pthread_self();
+		}
+#endif
+		found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT);
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+		do_one_event_thid = -1;
+		pthread_mutex_unlock(&mtx_do_one_event);
+#endif
+
+		if (found_event) {
 		    tick_counter++;
 		} else {
 		    tick_counter += no_event_tick;
@@ -687,6 +738,8 @@
 {
     VALUE vflags;
     int flags;
+    int found_event;
+    int recursive_lock = 0;
 
     if (rb_scan_args(argc, argv, "01", &vflags) == 0) {
 	flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
@@ -708,7 +761,23 @@
 	}
     }
 
-    if (Tcl_DoOneEvent(flags)) {
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+    if (pthread_mutex_trylock(&mtx_do_one_event) == EBUSY) {
+	if (pthread_self() != do_one_event_thid) {
+	    pthread_mutex_lock(&mtx_do_one_event);
+	    do_one_event_thid = pthread_self();
+	}
+    } else {
+	do_one_event_thid = pthread_self();
+    }
+#endif
+    found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT);
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+    do_one_event_thid = -1;
+    pthread_mutex_unlock(&mtx_do_one_event);
+#endif
+
+    if (found_event) {
 	return Qtrue;
     } else {
 	return Qfalse;
@@ -736,7 +805,7 @@
 
 /* Tcl command `ruby' */
 static VALUE
-ip_eval_rescue(failed, einfo)
+ip_ruby_eval_rescue(failed, einfo)
     VALUE *failed;
     VALUE einfo;
 {
@@ -744,55 +813,38 @@
     return Qnil;
 }
 
-/* restart Tk */
-static VALUE
-lib_restart(self)
-    VALUE self;
-{
-    struct tcltkip *ptr = get_ip(self);
-
-    rb_secure(4);
-
-    /* destroy the root wdiget */
-    ptr->return_value = Tcl_Eval(ptr->ip, "destroy .");
-    /* ignore ERROR */
-    DUMP2("(TCL_Eval result) %d", ptr->return_value);
+struct eval_body_arg {
+    char  *string;
+    VALUE failed;
+};
 
-    /* execute Tk_Init of Tk_SafeInit */
-#if TCL_MAJOR_VERSION >= 8
-    if (Tcl_IsSafe(ptr->ip)) {
-	DUMP1("Tk_SafeInit");
-	if (Tk_SafeInit(ptr->ip) == TCL_ERROR) {
-	    rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
-	}
-    } else {
-	DUMP1("Tk_Init");
-	if (Tk_Init(ptr->ip) == TCL_ERROR) {
-	    rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
-	}
-    }
-#else
-    DUMP1("Tk_Init");
-    if (Tk_Init(ptr->ip) == TCL_ERROR) {
-	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
-    }
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+pthread_mutex_t mtx_ip_ruby = PTHREAD_MUTEX_INITIALIZER;
 #endif
 
-    return Qnil;
+static VALUE
+ip_ruby_eval_body(arg)
+     struct eval_body_arg *arg;
+{
+    rb_trap_immediate = 0;
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+    pthread_mutex_lock(&mtx_ip_ruby);
+#endif
+    return rb_rescue2(rb_eval_string, (VALUE)arg->string, 
+		      ip_ruby_eval_rescue, (VALUE)&(arg->failed),
+		      rb_eStandardError, rb_eScriptError, rb_eSystemExit, 
+		      (VALUE)0);
 }
 
 static VALUE
-ip_restart(self)
-    VALUE self;
+ip_ruby_eval_ensure(trapflag)
+     VALUE trapflag;
 {
-    struct tcltkip *ptr = get_ip(self);
-
-    rb_secure(4);
-    if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
-	/* slave IP */
-	return Qnil;
-    }
-    return lib_restart(self);
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+    pthread_mutex_unlock(&mtx_ip_ruby);
+#endif
+    rb_trap_immediate = NUM2INT(trapflag);
+    return Qnil;
 }
 
 static int
@@ -811,9 +863,9 @@
 #endif
 {
     VALUE res;
-    int old_trapflg;
+    int old_trapflag;
     VALUE failed = 0;
-    char *arg;
+    struct eval_body_arg arg;
     int  dummy;
 
     /* ruby command has 1 arg. */
@@ -823,20 +875,16 @@
 
     /* get C string from Tcl object */
 #if TCL_MAJOR_VERSION >= 8
-    arg = Tcl_GetStringFromObj(argv[1], &dummy);
+    arg.string = Tcl_GetStringFromObj(argv[1], &dummy);
 #else
-    arg = argv[1];
+    arg.string = argv[1];
 #endif
 
     /* evaluate the argument string by ruby */
     DUMP2("rb_eval_string(%s)", arg);
-    old_trapflg = rb_trap_immediate;
-    rb_trap_immediate = 0;
-    res = rb_rescue2(rb_eval_string, (VALUE)arg, 
-                     ip_eval_rescue, (VALUE)&failed,
-                     rb_eStandardError, rb_eScriptError, rb_eSystemExit, 
-		     (VALUE)0);
-    rb_trap_immediate = old_trapflg;
+    old_trapflag = rb_trap_immediate;
+    res = rb_ensure(ip_ruby_eval_body, (VALUE)&arg, 
+		    ip_ruby_eval_ensure, INT2FIX(old_trapflag));
 
     /* status check */
     if (failed) {
@@ -1743,9 +1791,10 @@
     }
 }
 
+
 /* eval string in tcl by Tcl_Eval() */
 static VALUE
-ip_eval(self, str)
+ip_eval_real(self, str)
     VALUE self;
     VALUE str;
 {
@@ -1767,6 +1816,184 @@
     /* pass back the result (as string) */
     /* return(rb_str_new2(ptr->ip->result)); */
     return(rb_tainted_str_new2(ptr->ip->result));
+}
+
+static VALUE
+evq_safelevel_handler(arg, evq)
+    VALUE arg;
+    VALUE evq;
+{
+    struct eval_queue *q;
+
+    Data_Get_Struct(evq, struct eval_queue, q);
+    DUMP2("(safe-level handler) $SAFE = %d", q->safe_level);
+    rb_set_safe_level(q->safe_level);
+    return ip_eval_real(q->obj, q->str);
+}
+
+int eval_queue_handler _((Tcl_Event *, int));
+int
+eval_queue_handler(evPtr, flags)
+    Tcl_Event *evPtr;
+    int flags;
+{
+    struct eval_queue *q = (struct eval_queue *)evPtr;
+
+    DUMP2("do_eval_queue_handler : evPtr = %lx", evPtr);
+    DUMP2("eval queue_thread : %lx", rb_thread_current());
+    DUMP2("added by thread : %lx", q->thread);
+
+    if (q->done) {
+	DUMP1("processed by another event-loop");
+	return 0;
+    } else {
+	DUMP1("process it on current event-loop");
+    }
+
+    /* process it */
+    q->done = 1;
+
+    /* check safe-level */
+    if (rb_safe_level() != q->safe_level) {
+	*(q->result) 
+	    = rb_funcall(rb_proc_new(evq_safelevel_handler, 
+				     Data_Wrap_Struct(rb_cData,0,0,q)), 
+			 rb_intern("call"), 0);
+    } else {
+    DUMP2("call eval_real (for caller thread:%lx)", q->thread);
+    DUMP2("call eval_real (current thread:%lx)", rb_thread_current());
+	*(q->result) = ip_eval_real(q->obj, q->str);
+    }
+
+    /* back to caller */
+    DUMP2("back to caller (caller thread:%lx)", q->thread);
+    DUMP2("               (current thread:%lx)", rb_thread_current());
+    rb_thread_run(q->thread);
+    DUMP1("finish back to caller");
+
+    /* end of handler : remove it */
+    return 1;
+}
+
+static VALUE
+ip_eval(self, str)
+    VALUE self;
+    VALUE str;
+{
+    struct eval_queue *tmp;
+    VALUE current = rb_thread_current();
+    VALUE result;
+    VALUE *alloc_result;
+    Tcl_QueuePosition position;
+
+    if (eventloop_thread == 0 || current == eventloop_thread) {
+	if (eventloop_thread) {
+	    DUMP2("eval from current eventloop %lx", current);
+	} else {
+	    DUMP2("eval from thread:%lx but no eventloop", current);
+	}
+	result = ip_eval_real(self, str);
+	if (rb_obj_is_kind_of(result, rb_eException)) {
+	    rb_exc_raise(result);
+	}
+	return result;
+    }
+
+    DUMP2("eval from thread %lx (NOT current eventloop)", current);
+
+    /* allocate memory (protected from Tcl_ServiceEvent) */
+    alloc_result = ALLOC(VALUE);
+
+    /* allocate memory (freed by Tcl_ServiceEvent) */
+    tmp = (struct eval_queue *)Tcl_Alloc(sizeof(struct eval_queue));
+
+    /* construct event data */
+    tmp->done = 0;
+    tmp->obj = self;
+    tmp->str = str;
+    tmp->result = alloc_result;
+    tmp->thread = current;
+    tmp->safe_level = rb_safe_level();
+    tmp->ev.proc = eval_queue_handler;
+    position = TCL_QUEUE_TAIL;
+
+    /* add the handler to Tcl event queue */
+    DUMP1("add handler");
+    Tcl_QueueEvent(&(tmp->ev), position);
+
+    /* wait for the handler to be processed */
+    DUMP2("wait for handler (current thread:%lx)", current);
+    rb_thread_stop();
+    DUMP2("back from handler (current thread:%lx)", current);
+
+    /* get result & free allocated memory */
+    result = *alloc_result;
+    free(alloc_result);
+    if (rb_obj_is_kind_of(result, rb_eException)) {
+	rb_exc_raise(result);
+    }
+
+    return result;
+}
+
+
+/* restart Tk */
+static VALUE
+lib_restart(self)
+    VALUE self;
+{
+    struct tcltkip *ptr = get_ip(self);
+
+    rb_secure(4);
+
+#if defined(HAVE_LIBPTHREAD) && defined(USE_PTHREAD_EXTLIB)
+    rb_raise(rb_eRuntimeError, 
+	     "not support 'restart' under pthread-enabled Tk");
+#endif
+
+    /* destroy the root wdiget */
+    /* ptr->return_value = Tcl_Eval(ptr->ip, "destroy ."); */
+    ptr->return_value = FIX2INT(ip_eval(self, "destroy ."));
+    /* ignore ERROR */
+    DUMP2("(TCL_Eval result) %d", ptr->return_value);
+    Tcl_ResetResult(ptr->ip);
+
+    /* execute Tk_Init of Tk_SafeInit */
+#if TCL_MAJOR_VERSION >= 8
+    if (Tcl_IsSafe(ptr->ip)) {
+	DUMP1("Tk_SafeInit");
+	if (Tk_SafeInit(ptr->ip) == TCL_ERROR) {
+	    rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+	}
+    } else {
+	DUMP1("Tk_Init");
+	if (Tk_Init(ptr->ip) == TCL_ERROR) {
+	    rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+	}
+    }
+#else
+    DUMP1("Tk_Init");
+    if (Tk_Init(ptr->ip) == TCL_ERROR) {
+	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+    }
+#endif
+
+    return Qnil;
+}
+
+
+static VALUE
+ip_restart(self)
+    VALUE self;
+{
+    struct tcltkip *ptr = get_ip(self);
+
+    rb_secure(4);
+    if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+	/* slave IP */
+	return Qnil;
+    }
+    return lib_restart(self);
 }
 
 static VALUE

-- 
                                         永井 秀利 (九工大 知能情報)
                                             nagai / ai.kyutech.ac.jp