[ruby-list:39460] Re: trial version of Ruby/Tk
From:
Hidetoshi NAGAI <nagai@...>
Date:
2004-04-01 04:09:56 UTC
List:
ruby-list #39460
永井@知能．九工大です．
From: "Shirai,Kaoru" <shirai@korinkan.co.jp>
Subject: [ruby-list:39454] Re: trial version of Ruby/Tk
Date: Wed, 31 Mar 2004 21:19:50 +0900
Message-ID: <20040331.211944.884114422.nobody@localhost>
> tcltk20040323を Ruby-1.8.1(i686-linux) + Tk8.4.6 で試してみました。
> $ ruby -r tk -e 'exit'
> とすると、TERMシグナルを受けるまで固まってしまいます。ちなみに、exit!
> やスクリプトの終端に達したときは正常に終了するのですが…？
報告をありがとうございます．
手元でさらに改修を加えたものでは固まらないように見えます．
お手数ですが tcltk20040323 版に添付パッチを適用したもので
試してみていただけませんか．
# もしかすると，Exerb で Tk が正常に終了しないというのと
# 同じ原因なのかもしれないですね．
バグ修正に加え，Tcl/Tk8.5a1 の新機能にまで対応させた (つもりの (^_^;)
新しいものは近いうちに出します．
添付パッチはそれに含まれる予定のものとの差分です．
--- ../20040323/tcltklib/tcltklib.c 2004-03-23 18:06:03.000000000 +0900
+++ tcltklib.c 2004-04-01 12:59:24.000000000 +0900
@@ -101,6 +101,23 @@
VALUE result;
VALUE thread;
};
+
+void
+invoke_queue_mark(struct invoke_queue *q)
+{
+ rb_gc_mark(q->interp);
+ rb_gc_mark(q->result);
+ rb_gc_mark(q->thread);
+}
+
+void
+eval_queue_mark(struct eval_queue *q)
+{
+ rb_gc_mark(q->interp);
+ rb_gc_mark(q->result);
+ rb_gc_mark(q->thread);
+}
+
static VALUE eventloop_thread;
static VALUE watchdog_thread;
@@ -458,7 +475,9 @@
DUMP1("check Root Widget");
if (check_root && Tk_GetNumMainWindows() == 0) {
run_timer_flag = 0;
- rb_trap_exec();
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
+ }
return 1;
}
@@ -467,23 +486,6 @@
loop_counter = 0;
}
-#if 0
- if (run_timer_flag) {
- /*
- DUMP1("timer interrupt");
- run_timer_flag = 0;
- DUMP1("call rb_trap_exec()");
- rb_trap_exec();
- */
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- run_timer_flag = 0;
- rb_trap_exec();
- return 1;
- }
- }
-#endif
-
} else {
int tick_counter;
@@ -505,31 +507,32 @@
tick_counter++;
} else {
tick_counter += no_event_tick;
-#if 0
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- return 1;
- }
-#endif
rb_thread_wait_for(t);
}
+ if (watchdog_thread != 0 && eventloop_thread != current) {
+ return 1;
+ }
+
DUMP1("check Root Widget");
if (check_root && Tk_GetNumMainWindows() == 0) {
run_timer_flag = 0;
- rb_trap_exec();
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
+ }
return 1;
}
+ DUMP1("trap check");
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
+ }
+
if (loop_counter++ > 30000) {
/* fprintf(stderr, "loop_counter > 30000\n"); */
loop_counter = 0;
}
- if (watchdog_thread != 0 && eventloop_thread != current) {
- return 1;
- }
-
if (run_timer_flag) {
/*
DUMP1("timer interrupt");
@@ -538,25 +541,11 @@
break; /* switch to other thread */
}
}
-
-#if 0
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- return 1;
- }
-#endif
}
- /* rb_thread_schedule(); */
- if (run_timer_flag) {
- run_timer_flag = 0;
- rb_trap_exec();
- } else {
- DUMP1("thread scheduling");
- if (is_ruby_native_thread()) {
- rb_thread_schedule();
- }
- }
+ DUMP1("trap check & thread scheduling");
+ CHECK_INTS;
+
}
return 1;
}
@@ -866,7 +855,7 @@
/* ruby command has 1 arg. */
if (argc != 2) {
- rb_raise(rb_eArgError, "wrong # of arguments (%d for 1)", argc);
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc);
}
/* get C string from Tcl object */
@@ -907,7 +896,7 @@
/* status check */
if (arg.failed) {
VALUE eclass;
- /* volatile VALUE backtrace; */
+ volatile VALUE backtrace;
DUMP1("(rb_eval_string result) failed");
@@ -916,16 +905,18 @@
res = arg.failed;
eclass = rb_obj_class(res);
-#if 0
+#if 1
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
backtrace = rb_ary_join(rb_funcall(res, rb_intern("backtrace"), 0, 0),
rb_str_new2("\n"));
StringValue(backtrace);
- /*###*/fprintf(stderr, RSTRING(backtrace)->ptr);
+ /*###*//* fprintf(stderr, RSTRING(backtrace)->ptr); */
Tcl_AddErrorInfo(interp, RSTRING(backtrace)->ptr);
+ /* Tcl_GlobalEval(interp, "puts {>>>}; puts $errorInfo; puts {<<}"); */
+
rb_thread_critical = thr_crit_bup;
#endif
@@ -1842,14 +1833,32 @@
/* destroy interpreter */
+VALUE del_root(ip)
+ Tcl_Interp *ip;
+{
+ Tcl_Preserve(ip);
+ Tcl_Eval(ip, "catch [destroy .]");
+ Tcl_Release(ip);
+ return Qnil;
+}
+
static void
ip_free(ptr)
struct tcltkip *ptr;
{
- DUMP1("Tcl_DeleteInterp");
+ int try;
+
+ DUMP1("free Tcl Interp");
if (ptr) {
+ Tcl_ResetResult(ptr->ip);
+ if (!Tcl_InterpDeleted(ptr->ip)) {
+ for(try = 0; try < 5; try++) {
+ if (!Tk_GetNumMainWindows()) break;
+ rb_protect(del_root, (VALUE)(ptr->ip), 0);
+ }
+ Tcl_DeleteInterp(ptr->ip);
+ }
Tcl_Release((ClientData)ptr->ip);
- Tcl_DeleteInterp(ptr->ip);
free(ptr);
}
}
@@ -2233,13 +2242,14 @@
/* check safe-level */
if (rb_safe_level() != q->safe_level) {
+ volatile VALUE q_dat;
#ifdef HAVE_NATIVETHREAD
if (!is_ruby_native_thread()) {
rb_bug("cross-thread violation on eval_queue_handler()");
}
#endif
- ret = rb_funcall(rb_proc_new(evq_safelevel_handler,
- Data_Wrap_Struct(rb_cData,0,0,q)),
+ q_dat = Data_Wrap_Struct(rb_cData,eval_queue_mark,0,q);
+ ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat),
rb_intern("call"), 0);
} else {
DUMP2("call eval_real (for caller thread:%lx)", q->thread);
@@ -2635,10 +2645,8 @@
/* Invoke the C procedure */
#if TCL_MAJOR_VERSION >= 8
if (info.isNativeObjectProc) {
- TRAP_BEG;
- ptr->return_value = (*info.objProc)(info.objClientData,
- ptr->ip, objc, objv);
- TRAP_END;
+ ptr->return_value = (*info.objProc)(info.objClientData, ptr->ip,
+ objc, objv);
/* get the string value from the result object */
resultPtr = Tcl_GetObjResult(ptr->ip);
@@ -2649,17 +2657,14 @@
#endif
{
#if TCL_MAJOR_VERSION >= 8
- TRAP_BEG;
ptr->return_value = (*info.proc)(info.clientData, ptr->ip,
argc, (CONST84 char **)argv);
- TRAP_END;
free(argv);
#else /* TCL_MAJOR_VERSION < 8 */
- TRAP_BEG;
- ptr->return_value = (*info.proc)(info.clientData, ptr->ip, argc, argv);
- TRAP_END;
+ ptr->return_value = (*info.proc)(info.clientData, ptr->ip,
+ argc, argv);
#endif
}
@@ -2862,8 +2867,9 @@
/* check safe-level */
if (rb_safe_level() != q->safe_level) {
- ret = rb_funcall(rb_proc_new(ivq_safelevel_handler,
- Data_Wrap_Struct(rb_cData,0,0,q)),
+ volatile VALUE q_dat;
+ q_dat = Data_Wrap_Struct(rb_cData,invoke_queue_mark,0,q);
+ ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat),
rb_intern("call"), 0);
} else {
DUMP2("call invoke_real (for caller thread:%lx)", q->thread);
@@ -3042,13 +3048,17 @@
/* access Tcl variables */
static VALUE
-ip_get_variable(self, varname, flag)
+ip_get_variable(self, varname_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
int thr_crit_bup;
+ volatile VALUE varname, flag;
+
+ varname = varname_arg;
+ flag = flag_arg;
StringValue(varname);
@@ -3121,14 +3131,23 @@
}
static VALUE
-ip_get_variable2(self, varname, index, flag)
+ip_get_variable2(self, varname_arg, index_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE index;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
int thr_crit_bup;
+ volatile VALUE varname, index, flag;
+
+ if (index_arg == Qnil) {
+ return ip_get_variable(self, varname_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ flag = flag_arg;
StringValue(varname);
StringValue(index);
@@ -3138,7 +3157,7 @@
Tcl_Obj *nameobj, *idxobj, *ret;
char *s;
int len;
- VALUE strval;
+ volatile VALUE strval;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
@@ -3204,14 +3223,19 @@
}
static VALUE
-ip_set_variable(self, varname, value, flag)
+ip_set_variable(self, varname_arg, value_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE value;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE value_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
int thr_crit_bup;
+ volatile VALUE varname, value, flag;
+
+ varname = varname_arg;
+ value = value_arg;
+ flag = flag_arg;
StringValue(varname);
StringValue(value);
@@ -3221,7 +3245,7 @@
Tcl_Obj *nameobj, *valobj, *ret;
char *s;
int len;
- VALUE strval;
+ volatile VALUE strval;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
@@ -3305,15 +3329,25 @@
}
static VALUE
-ip_set_variable2(self, varname, index, value, flag)
+ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE index;
- VALUE value;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE value_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
int thr_crit_bup;
+ volatile VALUE varname, index, value, flag;
+
+ if (index_arg == Qnil) {
+ return ip_set_variable(self, varname_arg, value_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ value = value_arg;
+ flag = flag_arg;
StringValue(varname);
StringValue(index);
@@ -3324,7 +3358,7 @@
Tcl_Obj *nameobj, *idxobj, *valobj, *ret;
char *s;
int len;
- VALUE strval;
+ volatile VALUE strval;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
@@ -3415,12 +3449,16 @@
}
static VALUE
-ip_unset_variable(self, varname, flag)
+ip_unset_variable(self, varname_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
+ volatile VALUE varname, value, flag;
+
+ varname = varname_arg;
+ flag = flag_arg;
StringValue(varname);
ptr->return_value = Tcl_UnsetVar(ptr->ip, RSTRING(varname)->ptr,
@@ -3435,13 +3473,22 @@
}
static VALUE
-ip_unset_variable2(self, varname, index, flag)
+ip_unset_variable2(self, varname_arg, index_arg, flag_arg)
VALUE self;
- VALUE varname;
- VALUE index;
- VALUE flag;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
+ volatile VALUE varname, index, value, flag;
+
+ if (index_arg == Qnil) {
+ return ip_unset_variable(self, varname_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ flag = flag_arg;
StringValue(varname);
StringValue(index);
@@ -3823,6 +3870,7 @@
rb_define_const(var_flag, "LEAVE_ERR_MSG", INT2FIX(TCL_LEAVE_ERR_MSG));
rb_define_const(var_flag, "APPEND_VALUE", INT2FIX(TCL_APPEND_VALUE));
rb_define_const(var_flag, "LIST_ELEMENT", INT2FIX(TCL_LIST_ELEMENT));
+ rb_define_const(var_flag, "PARSE_VARNAME", INT2FIX(TCL_PARSE_PART1));
/* --------------------------------------------------------------- */
--
永井 秀利 （九工大 知能情報）
nagai@ai.kyutech.ac.jp