[ruby-list:39482] Re: trial version of Ruby/Tk
From:
Hidetoshi NAGAI <nagai@...>
Date:
2004-04-02 13:08:28 UTC
List:
ruby-list #39482
永井@知能．九工大です．
From: "Shirai,Kaoru" <shirai@korinkan.co.jp>
Subject: [ruby-list:39476] Re: trial version of Ruby/Tk
Date: Fri, 2 Apr 2004 10:37:44 +0900
Message-ID: <20040402.103734.731573425.nobody@localhost>
> 最新の安定版ではどちらも正常終了しました。ただ、開発版では、
>
> ruby -r tcltklib -e nil
>
> は正常終了するのですが、
>
> ruby -r tcltklib -e exit
>
> はさらに謎な結果になってしまいました。ときどき固まるのです。
とりあえず，こちらをどうにかしたいと思います．
Tcl_FindExecutable の実行を完了しないうちに
ruby が終了してしまっているのではないかと疑ってますので，
[ruby-list:39471] の patch をあてたものに
さらに添付の patch をあてたものではどうでしょうか？
# ruby -r tk の方の問題も tcltklib.c と tk.rb との連携で
# fix できそうな気がしています．
--- tcltklib.c.old 2004-04-02 04:12:05.000000000 +0900
+++ tcltklib.c 2004-04-02 22:01:46.000000000 +0900
@@ -809,13 +809,6 @@
return Qnil;
}
-static VALUE
-ip_ruby_eval_string_wrapper(str)
- VALUE str;
-{
- return rb_eval_string((char*)str);
-}
-
struct eval_body_arg {
char *string;
VALUE failed;
@@ -826,7 +819,7 @@
struct eval_body_arg *arg;
{
VALUE ret;
- int status;
+ int status = 0;
int thr_crit_bup;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
@@ -840,7 +833,7 @@
rb_eStandardError, rb_eScriptError, rb_eSystemExit,
(VALUE)0);
#else
- ret = rb_protect(ip_ruby_eval_string_wrapper, (VALUE)arg->string, &status);
+ ret = rb_eval_string_protect(arg->string, &status);
if (status) {
char *errtype, *buf;
@@ -879,8 +872,6 @@
break;
case TAG_NEXT:
- case TAG_RETRY:
- case TAG_REDO:
errtype = "LocalJumpError: ";
errtype_len = strlen(errtype);
len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
@@ -894,6 +885,11 @@
RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
break;
+ case TAG_RETRY:
+ case TAG_REDO:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
case TAG_RAISE:
case TAG_FATAL:
RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
@@ -1036,7 +1032,8 @@
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- Tcl_Eval(interp, "destroy .");
+ /* Tcl_Eval(interp, "destroy ."); */
+ Tk_DestroyWindow(Tk_MainWindow(interp));
StringValue(res);
Tcl_AppendResult(interp, RSTRING(res)->ptr, (char*)NULL);
@@ -1953,26 +1950,36 @@
ip_free(ptr)
struct tcltkip *ptr;
{
- int try;
+ int try = 3;
+ char *finalize_hook = "interp_finalize_hook";
+ Tcl_CmdInfo info;
+ int thr_crit_bup;
DUMP1("free Tcl Interp");
if (ptr) {
- Tcl_ResetResult(ptr->ip);
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
if (!Tcl_InterpDeleted(ptr->ip)) {
-#if 0
+ Tcl_ResetResult(ptr->ip);
Tcl_Preserve(ptr->ip);
- Tk_DeleteBindingTable(Tk_CreateBindingTable(ptr->ip));
- for(try = 0; try < 5; try++) {
+ if (Tcl_GetCommandInfo(ptr->ip, finalize_hook, &info)) {
+ DUMP2("call finalize hook proc '%s'", finalize_hook);
+ Tcl_Eval(ptr->ip, finalize_hook);
+ }
+ for(; try > 0; try--) {
if (!Tk_GetNumMainWindows()) break;
rb_protect(del_root, (VALUE)(ptr->ip), 0);
}
Tcl_Release(ptr->ip);
-#endif
Tcl_DeleteInterp(ptr->ip);
}
Tcl_Release((ClientData)ptr->ip);
free(ptr);
+
+ rb_thread_critical = thr_crit_bup;
}
+ DUMP1("complete freeing Tcl Interp");
}
/* create and initialize interpreter */
@@ -2011,7 +2018,11 @@
/* from Tcl_AppInit() */
DUMP1("Tcl_Init");
if (Tcl_Init(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
/* set variables */
@@ -2039,7 +2050,11 @@
if (with_tk) {
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
DUMP1("Tcl_StaticPackage(\"Tk\")");
#if TCL_MAJOR_VERSION >= 8
@@ -2161,7 +2176,11 @@
struct tcltkip *ptr = get_ip(self);
if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
return self;
@@ -2270,8 +2289,13 @@
#endif
if (ptr->return_value == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ return create_ip_exc(self, rb_eRuntimeError,
+ "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
return create_ip_exc(self, rb_eRuntimeError,
"%s", ptr->ip->result);
+#endif
}
DUMP2("(TCL_Eval result) %d", ptr->return_value);
@@ -2506,13 +2530,15 @@
DUMP1("Tk_SafeInit");
if (Tk_SafeInit(ptr->ip) == TCL_ERROR) {
rb_thread_critical = thr_crit_bup;
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ /* rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); */
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
}
} else {
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
rb_thread_critical = thr_crit_bup;
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ /* rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); */
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
}
}
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2854,13 +2880,26 @@
/* exception on mainloop */
if (ptr->return_value == TCL_ERROR) {
if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) {
+#if TCL_MAJOR_VERSION >= 8
+ return create_ip_exc(interp, rb_eRuntimeError,
+ "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
return create_ip_exc(interp, rb_eRuntimeError,
"%s", ptr->ip->result);
+#endif
} else {
if (event_loop_abort_on_exc < 0) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_warning("%s (ignore)", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_warning("%s (ignore)", ptr->ip->result);
+#endif
} else {
+#if TCL_MAJOR_VERSION >= 8
+ rb_warn("%s (ignore)", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_warn("%s (ignore)", ptr->ip->result);
+#endif
}
Tcl_ResetResult(ptr->ip);
return rb_tainted_str_new2("");
@@ -3075,10 +3114,11 @@
}
static VALUE
-ip_invoke(argc, argv, obj)
+ip_invoke_with_position(argc, argv, obj, position)
int argc;
VALUE *argv;
VALUE obj;
+ Tcl_QueuePosition position;
{
struct invoke_queue *ivq;
char *s;
@@ -3090,7 +3130,6 @@
VALUE current = rb_thread_current();
volatile VALUE result = rb_ary_new2(1);
volatile VALUE ret;
- Tcl_QueuePosition position;
#if TCL_MAJOR_VERSION >= 8
Tcl_Obj **av = (Tcl_Obj **)NULL;
@@ -3175,7 +3214,6 @@
ivq->thread = current;
ivq->safe_level = rb_safe_level();
ivq->ev.proc = invoke_queue_handler;
- position = TCL_QUEUE_TAIL;
/* add the handler to Tcl event queue */
DUMP1("add handler");
@@ -3226,6 +3264,23 @@
return (INT2FIX(ptr->return_value));
}
+static VALUE
+ip_invoke(argc, argv, obj)
+ int argc;
+ VALUE *argv;
+ VALUE obj;
+{
+ return ip_invoke_with_position(argc, argv, obj, TCL_QUEUE_TAIL);
+}
+
+static VALUE
+ip_invoke_immediate(argc, argv, obj)
+ int argc;
+ VALUE *argv;
+ VALUE obj;
+{
+ return ip_invoke_with_position(argc, argv, obj, TCL_QUEUE_HEAD);
+}
/* access Tcl variables */
static VALUE
@@ -3264,7 +3319,11 @@
rb_thread_critical = thr_crit_bup;
if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
Tcl_IncrRefCount(ret);
@@ -3359,7 +3418,11 @@
if (ret == (Tcl_Obj*)NULL) {
Tcl_DecrRefCount(ret);
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
s = Tcl_GetStringFromObj(ret, &len);
@@ -3396,9 +3459,17 @@
ret = Tcl_GetVar2(RSTRING(varname)->ptr, RSTRING(index)->ptr,
FIX2INT(flag));
if (ret == (char*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
+#if TCL_MAJOR_VERSION >= 8
+ return(rb_tainted_str_new2(Tcl_GetStringResult(ptr->ip)));
+#else /* TCL_MAJOR_VERSION < 8 */
return(rb_tainted_str_new2(ptr->ip->result));
+#endif
}
#endif
}
@@ -3468,7 +3539,11 @@
Tcl_DecrRefCount(valobj);
if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
Tcl_IncrRefCount(ret);
@@ -3502,9 +3577,17 @@
ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, (char*)NULL,
RSTRING(value)->ptr, (int)FIX2INT(flag));
if (ret == NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
+#if TCL_MAJOR_VERSION >= 8
+ return(rb_tainted_str_new2(Tcl_GetStringResult(ptr->ip)));
+#else /* TCL_MAJOR_VERSION < 8 */
return(rb_tainted_str_new2(ptr->ip->result));
+#endif
}
#endif
}
@@ -3585,7 +3668,11 @@
rb_thread_critical = thr_crit_bup;
if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
Tcl_IncrRefCount(ret);
@@ -3646,7 +3733,11 @@
FIX2INT(flag));
if (ptr->return_value == TCL_ERROR) {
if (FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
return Qfalse;
}
@@ -3678,7 +3769,11 @@
RSTRING(index)->ptr, FIX2INT(flag));
if (ptr->return_value == TCL_ERROR) {
if (FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
return Qfalse;
}
@@ -3810,7 +3905,11 @@
if (result == TCL_ERROR) {
Tcl_DecrRefCount(listobj);
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
for(idx = 0; idx < objc; idx++) {
@@ -3874,7 +3973,11 @@
if (Tcl_SplitList(ptr->ip, RSTRING(list_ptr)->ptr,
&argc, &argv) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
ary = rb_ary_new2(argc);
@@ -4022,12 +4125,16 @@
void
Init_tcltklib()
{
+ int thr_crit_bup;
+
VALUE lib = rb_define_module("TclTkLib");
VALUE ip = rb_define_class("TclTkIp", rb_cObject);
VALUE ev_flag = rb_define_module_under(lib, "EventFlag");
VALUE var_flag = rb_define_module_under(lib, "VarAccessFlag");
+ /* --------------------------------------------------------------- */
+
#if defined USE_TCL_STUBS && defined USE_TK_STUBS
extern int ruby_tcltk_stubs();
int ret = ruby_tcltk_stubs();
@@ -4038,6 +4145,26 @@
/* --------------------------------------------------------------- */
+ eventloop_thread = 0;
+ watchdog_thread = 0;
+
+ /* --------------------------------------------------------------- */
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+#ifdef __MACOS__
+ _macinit();
+#endif
+
+ /* from Tk_Main() */
+ DUMP1("Tcl_FindExecutable");
+ Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
+
+ rb_thread_critical = thr_crit_bup;
+
+ /* --------------------------------------------------------------- */
+
rb_define_const(ev_flag, "NONE", INT2FIX(0));
rb_define_const(ev_flag, "WINDOW", INT2FIX(TCL_WINDOW_EVENTS));
rb_define_const(ev_flag, "FILE", INT2FIX(TCL_FILE_EVENTS));
@@ -4150,21 +4277,6 @@
rb_define_method(ip, "restart", ip_restart, 0);
/* --------------------------------------------------------------- */
-
- eventloop_thread = 0;
- watchdog_thread = 0;
-
- /* --------------------------------------------------------------- */
-
-#ifdef __MACOS__
- _macinit();
-#endif
-
- /*---- initialize tcl/tk libraries ----*/
- /* from Tk_Main() */
- DUMP1("Tcl_FindExecutable");
- Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
-
}
/* eof */
--
永井 秀利 （九工大 知能情報）
nagai@ai.kyutech.ac.jp