[ruby-list:39471] Re: trial version of Ruby/Tk
From:
Hidetoshi NAGAI <nagai@...>
Date:
2004-04-01 19:49:16 UTC
List:
ruby-list #39471
永井@知能．九工大です．
From: "Shirai,Kaoru" <shirai@korinkan.co.jp>
Subject: [ruby-list:39469] Re: trial version of Ruby/Tk
Date: Thu, 1 Apr 2004 22:35:23 +0900
Message-ID: <20040401.223517.641110685.nobody@localhost>
> 最新の安定版と開発版で試してみましたが、
(snip)
> 残念ながらどちらも固まってしまいました。むぅ。
ご迷惑をかけてます．
手元でトラブルを再現できないため今一つ確信を持てないのですが，
Tcl のインタープリタを解放する際に念のためルートウィジェットを
消去していることが，どうやら大きなお世話になっているようです．
ウィジェット消去の際に不要となるオブジェクトを解放するように
フックをかけているんですが，ルートウィジェットの消去処理の
呼び出しが原因で，このフックがインタープリタ解放の際にも
動いてしまっていました．
添付のパッチではいかがでしょうか？
[ruby-list:39460] のパッチをあてたものからのパッチです．
ついでに変更した部分が含まれているので大きくなってしまってますが，
対策の本質は元のファイルの 1850 行付近の修正だけです．
--- ../tcltklib.old/tcltklib.c 2004-04-01 12:59:24.000000000 +0900
+++ ./tcltklib.c 2004-04-02 04:12:05.000000000 +0900
@@ -45,8 +45,16 @@
# endif
#endif
-/* for ruby_debug */
+/* copied from eval.c */
+#define TAG_RETURN 0x1
+#define TAG_BREAK 0x2
+#define TAG_NEXT 0x3
+#define TAG_RETRY 0x4
+#define TAG_REDO 0x5
+#define TAG_RAISE 0x6
+#define TAG_FATAL 0x8
+/* for ruby_debug */
#define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
#define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
@@ -56,6 +64,7 @@
*/
/* for callback break & continue */
+static VALUE eTkCallbackReturn;
static VALUE eTkCallbackBreak;
static VALUE eTkCallbackContinue;
@@ -792,13 +801,21 @@
/* Tcl command `ruby' */
static VALUE
ip_ruby_eval_rescue(failed, einfo)
- VALUE *failed;
+ VALUE failed;
VALUE einfo;
{
- *failed = einfo;
+ DUMP1("call ip_ruby_eval_rescue");
+ RARRAY(failed)->ptr[0] = einfo;
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;
@@ -809,15 +826,91 @@
struct eval_body_arg *arg;
{
VALUE ret;
+ int status;
int thr_crit_bup;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
+ DUMP1("call ip_ruby_eval_body");
rb_trap_immediate = 0;
+
+#if 0
ret = rb_rescue2(rb_eval_string, (VALUE)arg->string,
- ip_ruby_eval_rescue, (VALUE)&(arg->failed),
+ ip_ruby_eval_rescue, arg->failed,
rb_eStandardError, rb_eScriptError, rb_eSystemExit,
(VALUE)0);
+#else
+ ret = rb_protect(ip_ruby_eval_string_wrapper, (VALUE)arg->string, &status);
+
+ if (status) {
+ char *errtype, *buf;
+ int errtype_len, len;
+ VALUE old_gc;
+
+ old_gc = rb_gc_disable();
+
+ switch(status) {
+ case TAG_RETURN:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackReturn, buf);
+ break;
+
+ case TAG_BREAK:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackBreak, buf);
+ 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;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
+ break;
+
+ case TAG_RAISE:
+ case TAG_FATAL:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
+ default:
+ buf = ALLOC_N(char, 256);
+ sprintf(buf, "unknown longjmp status %d", status);
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(rb_eException, buf);
+ break;
+ }
+
+ if (old_gc == Qfalse) rb_gc_enable();
+
+ ret = Qnil;
+ }
+#endif
rb_thread_critical = thr_crit_bup;
@@ -848,9 +941,10 @@
char *argv[];
#endif
{
- VALUE res;
+ volatile VALUE res;
+ volatile VALUE exception = rb_ary_new2(1);
int old_trapflag;
- struct eval_body_arg arg;
+ struct eval_body_arg *arg;
int thr_crit_bup;
/* ruby command has 1 arg. */
@@ -858,6 +952,9 @@
rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc);
}
+ /* allocate */
+ arg = ALLOC(struct eval_body_arg);
+
/* get C string from Tcl object */
#if TCL_MAJOR_VERSION >= 8
{
@@ -866,35 +963,42 @@
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
+
str = Tcl_GetStringFromObj(argv[1], &len);
+ arg->string = ALLOC_N(char, len + 1);
+ strncpy(arg->string, str, len);
+ arg->string[len] = 0;
+
rb_thread_critical = thr_crit_bup;
- arg.string = ALLOC_N(char, len + 1);
- strncpy(arg.string, str, len);
- arg.string[len] = 0;
}
#else /* TCL_MAJOR_VERSION < 8 */
- arg.string = argv[1];
+ arg->string = argv[1];
#endif
- arg.failed = 0;
+ /* arg.failed = 0; */
+ RARRAY(exception)->ptr[0] = Qnil;
+ arg->failed = exception;
/* evaluate the argument string by ruby */
- DUMP2("rb_eval_string(%s)", arg.string);
+ DUMP2("rb_eval_string(%s)", arg->string);
old_trapflag = rb_trap_immediate;
#ifdef HAVE_NATIVETHREAD
if (!is_ruby_native_thread()) {
rb_bug("cross-thread violation on ip_ruby()");
}
#endif
- res = rb_ensure(ip_ruby_eval_body, (VALUE)&arg,
+ res = rb_ensure(ip_ruby_eval_body, (VALUE)arg,
ip_ruby_eval_ensure, INT2FIX(old_trapflag));
#if TCL_MAJOR_VERSION >= 8
- free(arg.string);
+ free(arg->string);
#endif
+ free(arg);
+
/* status check */
- if (arg.failed) {
+ /* if (arg.failed) { */
+ if (!NIL_P(RARRAY(exception)->ptr[0])) {
VALUE eclass;
volatile VALUE backtrace;
@@ -902,13 +1006,13 @@
Tcl_ResetResult(interp);
- res = arg.failed;
+ res = RARRAY(exception)->ptr[0];
eclass = rb_obj_class(res);
-#if 1
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
+ DUMP1("set backtrace");
backtrace = rb_ary_join(rb_funcall(res, rb_intern("backtrace"), 0, 0),
rb_str_new2("\n"));
StringValue(backtrace);
@@ -918,9 +1022,11 @@
/* Tcl_GlobalEval(interp, "puts {>>>}; puts $errorInfo; puts {<<}"); */
rb_thread_critical = thr_crit_bup;
-#endif
- if (eclass == eTkCallbackBreak) {
+ if (eclass == eTkCallbackReturn) {
+ return TCL_RETURN;
+
+ } else if (eclass == eTkCallbackBreak) {
return TCL_BREAK;
} else if (eclass == eTkCallbackContinue) {
@@ -958,6 +1064,7 @@
RSTRING(res)->len, &dstr);
Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (char*)NULL);
+ DUMP2("error message:%s", Tcl_DStringValue(&dstr));
rb_thread_critical = thr_crit_bup;
@@ -1837,7 +1944,7 @@
Tcl_Interp *ip;
{
Tcl_Preserve(ip);
- Tcl_Eval(ip, "catch [destroy .]");
+ Tk_DestroyWindow(Tk_MainWindow(ip));
Tcl_Release(ip);
return Qnil;
}
@@ -1852,10 +1959,15 @@
if (ptr) {
Tcl_ResetResult(ptr->ip);
if (!Tcl_InterpDeleted(ptr->ip)) {
+#if 0
+ Tcl_Preserve(ptr->ip);
+ Tk_DeleteBindingTable(Tk_CreateBindingTable(ptr->ip));
for(try = 0; try < 5; 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);
@@ -2440,6 +2552,7 @@
Tcl_Interp *interp;
Tcl_Encoding encoding;
Tcl_DString dstr;
+ int taint_flag = OBJ_TAINTED(str);
struct tcltkip *ptr;
char *buf;
int thr_crit_bup;
@@ -2470,8 +2583,10 @@
Tcl_DStringFree(&dstr);
/* Tcl_ExternalToUtfDString(encoding,buf,strlen(buf),&dstr); */
Tcl_ExternalToUtfDString(encoding,buf,RSTRING(str)->len,&dstr);
- /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
- str = rb_tainted_str_new2(Tcl_DStringValue(&dstr));
+
+ /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
+ str = rb_str_new2(Tcl_DStringValue(&dstr));
+ if (taint_flag) OBJ_TAINT(str);
if (encoding != (Tcl_Encoding)NULL) {
Tcl_FreeEncoding(encoding);
@@ -2496,6 +2611,7 @@
Tcl_Interp *interp;
Tcl_Encoding encoding;
Tcl_DString dstr;
+ int taint_flag = OBJ_TAINTED(str);
struct tcltkip *ptr;
char *buf;
int thr_crit_bup;
@@ -2543,8 +2659,10 @@
Tcl_DStringFree(&dstr);
/* Tcl_UtfToExternalDString(encoding,buf,strlen(buf),&dstr); */
Tcl_UtfToExternalDString(encoding,buf,RSTRING(str)->len,&dstr);
- /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
- str = rb_tainted_str_new2(Tcl_DStringValue(&dstr));
+
+ /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
+ str = rb_str_new2(Tcl_DStringValue(&dstr));
+ if (taint_flag) OBJ_TAINT(str);
if (encoding != (Tcl_Encoding)NULL) {
Tcl_FreeEncoding(encoding);
@@ -2559,6 +2677,69 @@
return str;
}
+static VALUE
+lib_UTF_backslash_core(self, str, all_bs)
+ VALUE self;
+ VALUE str;
+ int all_bs;
+{
+#ifdef TCL_UTF_MAX
+ char *src_buf, *dst_buf, *ptr;
+ int read_len = 0, dst_len = 0;
+ int taint_flag = OBJ_TAINTED(str);
+ int thr_crit_bup;
+
+ StringValue(str);
+ if (!RSTRING(str)->len) {
+ return str;
+ }
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ src_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
+ strncpy(src_buf, RSTRING(str)->ptr, RSTRING(str)->len);
+ src_buf[RSTRING(str)->len] = 0;
+
+ dst_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
+
+ ptr = src_buf;
+ while(RSTRING(str)->len > ptr - src_buf) {
+ if (*ptr == '\\' && (all_bs || *(ptr + 1) == 'u')) {
+ dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
+ ptr += read_len;
+ } else {
+ *(dst_buf + (dst_len++)) = *(ptr++);
+ }
+ }
+
+ str = rb_str_new(dst_buf, dst_len);
+ if (taint_flag) OBJ_TAINT(str);
+
+ free(src_buf);
+ free(dst_buf);
+
+ rb_thread_critical = thr_crit_bup;
+#endif
+
+ return str;
+}
+
+static VALUE
+lib_UTF_backslash(self, str)
+ VALUE self;
+ VALUE str;
+{
+ return lib_UTF_backslash_core(self, str, 0);
+}
+
+static VALUE
+lib_Tcl_backslash(self, str)
+ VALUE self;
+ VALUE str;
+{
+ return lib_UTF_backslash_core(self, str, 1);
+}
#if TCL_MAJOR_VERSION >= 8
static VALUE
@@ -3570,13 +3751,15 @@
VALUE self;
VALUE list_str;
{
- struct tcltkip *ptr = get_ip(self);
+ struct tcltkip *ptr;
volatile VALUE ary, elem;
int idx;
int taint_flag = OBJ_TAINTED(list_str);
int result;
VALUE old_gc;
+ ptr = get_ip(self);
+
StringValue(list_str);
{
@@ -3848,6 +4031,7 @@
#if defined USE_TCL_STUBS && defined USE_TK_STUBS
extern int ruby_tcltk_stubs();
int ret = ruby_tcltk_stubs();
+
if (ret)
rb_raise(rb_eLoadError, "tcltklib: tcltk_stubs init error(%d)", ret);
#endif
@@ -3874,6 +4058,7 @@
/* --------------------------------------------------------------- */
+ eTkCallbackBreak = rb_define_class("TkCallbackReturn", rb_eStandardError);
eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
eTkCallbackContinue = rb_define_class("TkCallbackContinue",
rb_eStandardError);
@@ -3904,6 +4089,10 @@
rb_define_module_function(lib, "_merge_tklist", lib_merge_tklist, -1);
rb_define_module_function(lib, "_conv_listelement",
lib_conv_listelement, 1);
+ rb_define_module_function(lib, "_subst_UTF_backslash",
+ lib_UTF_backslash, 1);
+ rb_define_module_function(lib, "_subst_Tcl_backslash",
+ lib_Tcl_backslash, 1);
/* --------------------------------------------------------------- */
@@ -3965,6 +4154,8 @@
eventloop_thread = 0;
watchdog_thread = 0;
+ /* --------------------------------------------------------------- */
+
#ifdef __MACOS__
_macinit();
#endif
@@ -3973,6 +4164,7 @@
/* from Tk_Main() */
DUMP1("Tcl_FindExecutable");
Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
+
}
/* eof */
--
永井 秀利 （九工大 知能情報）
nagai@ai.kyutech.ac.jp