[ruby-dev:25567] Re: some problems on ext/tk/sample/**/*.rb
From:
Hidetoshi NAGAI <nagai@...>
Date:
2005-01-27 09:37:56 UTC
List:
ruby-dev #25567
永井@知能．九工大です．
From: Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
Subject: [ruby-dev:25556] Re: some problems on ext/tk/sample/**/*.rb
Date: Thu, 27 Jan 2005 02:02:57 +0900
Message-ID: <20050127.020253.71101772.nagai@ai.kyutech.ac.jp>
> 最後にもう一つだけ，Tcl_Eval を使わない方法を試してみたいと考えてます．
> うんざりしているとは思いますが，あと一度，協力をお願いできないでしょうか．
Tcl_Eval を使わない方法だと，逆に SEGV の可能性が
高くなってしまいました．(^_^;
仕方ないのでその代りに別のチェックを追加してみました．
これでもダメなら本当にお手上げ (少なくとも現時点では) ですので，
問題となっている終了処理を bcc32 の場合だけ一切行わないように
修正することにします．(;_;)
また，添付のパッチは
From: nobu@ruby-lang.org
Subject: [ruby-dev:25552] Re: merge tcltklib and tk
Date: Thu, 27 Jan 2005 00:18:07 +0900
Message-ID: <200501261518.j0QFI3Pm013241@sharui.nakada.niregi.kanuma.tochigi.jp>
> もう一点、cygwinで--with-tcltk-stubsを指定すると
> Tcl_GetCurrentNamespace()が未定義でリンクできないようです。
についても対策を行っているつもりです．
この件についても試してみて頂けると助かります．
Index: tcltklib.c
===================================================================
RCS file: /var/cvs/src/ruby/ext/tk/tcltklib.c,v
retrieving revision 1.1
diff -u -r1.1 tcltklib.c
--- tcltklib.c 25 Jan 2005 14:31:44 -0000 1.1
+++ tcltklib.c 27 Jan 2005 09:28:28 -0000
@@ -4,7 +4,7 @@
* Oct. 24, 1997 Y. Matsumoto
*/
-#define TCLTKLIB_RELEASE_DATE "2005-01-25"
+#define TCLTKLIB_RELEASE_DATE "2005-01-27"
#include "ruby.h"
#include "rubysig.h"
@@ -205,16 +205,32 @@
#endif
static int ip_null_namespace _((Tcl_Interp *));
-#if TCL_MAJOR_VERSION >= 8
-#ifndef Tcl_GetCurrentNamespace
+
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
+# ifndef Tcl_GetCurrentNamespace
EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _((Tcl_Interp *));
-#endif
+# endif
+# if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+# ifndef Tcl_GetCurrentNamespace
+#define FunctionNum_of_GetCurrentNamespace 124
+struct DummyTclIntStubs {
+ int magic;
+ struct TclIntStubHooks *hooks;
+ void (*func[FunctionNum_of_GetCurrentNamespace])();
+ Tcl_Namespace * (*tcl_GetCurrentNamespace) _((Tcl_Interp *));
+};
+EXTERN struct TclIntStubs *tclIntStubsPtr;
+#define Tcl_GetCurrentNamespace \
+ (((struct DummyTclIntStubs *)tclIntStubsPtr)->tcl_GetCurrentNamespace)
+# endif
+# endif
#endif
/*---- class TclTkIp ----*/
struct tcltkip {
Tcl_Interp *ip; /* the interpreter */
+ Tcl_Namespace *default_ns; /* default namespace */
int has_orig_exit; /* has original 'exit' command ? */
Tcl_CmdInfo orig_exit_info; /* command info of original 'exit' command */
int ref_count; /* reference count of rbtk_preserve_ip call */
@@ -3333,18 +3349,19 @@
Tcl_Preserve(slave);
- if (!Tcl_InterpDeleted(slave) && !ip_null_namespace(slave)) {
- if (Tcl_Eval(slave, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
- if (Tcl_GetCommandInfo(slave, CANCEL_AFTER_SCRIPTS, &info)) {
- DUMP2("call cancel after scripts proc '%s'",
- CANCEL_AFTER_SCRIPTS);
- Tcl_Eval(slave, CANCEL_AFTER_SCRIPTS);
- }
- }
+ if (!Tcl_InterpDeleted(slave) && !ip_null_namespace(slave) &&
+ Tcl_GetCommandInfo(slave, finalize_hook_name, &info)) {
+ DUMP2("call finalize hook proc '%s'", finalize_hook_name);
+ Tcl_Eval(slave, finalize_hook_name);
+ }
- if (Tcl_GetCommandInfo(slave, finalize_hook_name, &info)) {
- DUMP2("call finalize hook proc '%s'", finalize_hook_name);
- Tcl_Eval(slave, finalize_hook_name);
+ if (!Tcl_InterpDeleted(slave) &&
+ Tcl_Eval(slave, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
+ if (!Tcl_InterpDeleted(slave) && !ip_null_namespace(slave) &&
+ Tcl_GetCommandInfo(slave, CANCEL_AFTER_SCRIPTS, &info)) {
+ DUMP2("call cancel after scripts proc '%s'",
+ CANCEL_AFTER_SCRIPTS);
+ Tcl_Eval(slave, CANCEL_AFTER_SCRIPTS);
}
}
@@ -3355,7 +3372,7 @@
del_root(slave);
/* while(!rbtk_InterpDeleted(slave)) { */
if (!Tcl_InterpDeleted(slave)) {
- DUMP1("wait ip is deleted");
+ DUMP2("delete slave ip(%lx)", slave);
Tcl_DeleteInterp(slave);
}
@@ -3376,6 +3393,7 @@
{
Tcl_CmdInfo info;
int thr_crit_bup;
+ char* argv[2];
DUMP2("free Tcl Interp %lx", ptr->ip);
if (ptr) {
@@ -3384,7 +3402,9 @@
DUMP2("IP ref_count = %d", ptr->ref_count);
- if (!Tcl_InterpDeleted(ptr->ip) && !ip_null_namespace(ptr->ip)) {
+ if (!Tcl_InterpDeleted(ptr->ip) &&
+ !ip_null_namespace(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns) {
DUMP2("IP(%lx) is not deleted", ptr->ip);
/* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
@@ -3393,25 +3413,32 @@
Tcl_ResetResult(ptr->ip);
- if (Tcl_Eval(ptr->ip, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
- if (Tcl_GetCommandInfo(ptr->ip, CANCEL_AFTER_SCRIPTS, &info)) {
+ if (!Tcl_InterpDeleted(ptr->ip) && !ip_null_namespace(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
+ DUMP2("call finalize hook proc '%s'", finalize_hook_name);
+ Tcl_Eval(ptr->ip, finalize_hook_name);
+ }
+
+ if (!Tcl_InterpDeleted(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_Eval(ptr->ip, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
+ if (!Tcl_InterpDeleted(ptr->ip) &&
+ !ip_null_namespace(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_GetCommandInfo(ptr->ip, CANCEL_AFTER_SCRIPTS, &info)) {
DUMP2("call cancel after scripts proc '%s'",
CANCEL_AFTER_SCRIPTS);
Tcl_Eval(ptr->ip, CANCEL_AFTER_SCRIPTS);
}
}
- if (Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
- DUMP2("call finalize hook proc '%s'", finalize_hook_name);
- Tcl_Eval(ptr->ip, finalize_hook_name);
- }
-
/* del_root(ptr->ip); */
DUMP1("delete interp");
/* while(!rbtk_InterpDeleted(ptr->ip)) { */
if (!Tcl_InterpDeleted(ptr->ip)) {
- DUMP1("wait ip is deleted");
+ DUMP2("delete ip(%lx)", ptr->ip);
Tcl_DeleteInterp(ptr->ip);
}
@@ -3470,6 +3497,9 @@
rb_raise(rb_eRuntimeError, "fail to create a new Tk interpreter");
}
+ DUMP1("get current namespace");
+ ptr->default_ns = Tcl_GetCurrentNamespace(ptr->ip);
+
rbtk_preserve_ip(ptr);
DUMP2("IP ref_count = %d", ptr->ref_count);
current_interp = ptr->ip;
@@ -3711,6 +3741,7 @@
rb_thread_critical = thr_crit_bup;
rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter");
}
+ slave->default_ns = Tcl_GetCurrentNamespace(slave->ip);
rbtk_preserve_ip(slave);
slave->has_orig_exit
@@ -3878,25 +3909,31 @@
delete_slaves(ptr->ip);
DUMP1("finalize operation");
- if (Tcl_Eval(ptr->ip, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
- if (Tcl_GetCommandInfo(ptr->ip, CANCEL_AFTER_SCRIPTS, &info)) {
+ if (!Tcl_InterpDeleted(ptr->ip) && !ip_null_namespace(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
+ DUMP2("call finalize hook proc '%s'", finalize_hook_name);
+ Tcl_Eval(ptr->ip, finalize_hook_name);
+ }
+
+ if (!Tcl_InterpDeleted(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_Eval(ptr->ip, DEF_CANCEL_AFTER_SCRIPTS_PROC) == TCL_OK) {
+ if (!Tcl_InterpDeleted(ptr->ip) && !ip_null_namespace(ptr->ip) &&
+ Tcl_GetCurrentNamespace(ptr->ip) == ptr->default_ns &&
+ Tcl_GetCommandInfo(ptr->ip, CANCEL_AFTER_SCRIPTS, &info)) {
DUMP2("call cancel after scripts proc '%s'",
CANCEL_AFTER_SCRIPTS);
Tcl_Eval(ptr->ip, CANCEL_AFTER_SCRIPTS);
}
}
- if (Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
- DUMP2("call finalize hook proc '%s'", finalize_hook_name);
- Tcl_Eval(ptr->ip, finalize_hook_name);
- }
-
del_root(ptr->ip);
DUMP1("delete interp");
/* while(!rbtk_InterpDeleted(ptr->ip)) { */
if (!Tcl_InterpDeleted(ptr->ip)) {
- DUMP1("wait ip is deleted");
+ DUMP2("delete ip(%lx)", ptr->ip);
Tcl_DeleteInterp(ptr->ip);
}
@@ -3914,6 +3951,7 @@
#if TCL_MAJOR_VERSION < 8
return 0;
#else /* support Namespace */
+ DUMP2("current namespace %lx",Tcl_GetCurrentNamespace(interp));
return ( Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL );
#endif
}
@@ -4053,7 +4091,8 @@
Tcl_IncrRefCount(cmd);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(cmd);
rb_thread_critical = thr_crit_bup;
@@ -4094,7 +4133,8 @@
DUMP2("Tcl_Eval(%s)", cmd_str);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
ptr->return_value = TCL_OK;
return rb_tainted_str_new2("");
@@ -4299,7 +4339,8 @@
rb_secure(4);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
rb_raise(rb_eRuntimeError, "interpreter is deleted");
}
@@ -4788,7 +4829,8 @@
ptr = get_ip(interp);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
}
@@ -5270,7 +5312,8 @@
Tcl_IncrRefCount(nameobj);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(nameobj);
rb_thread_critical = thr_crit_bup;
@@ -5334,7 +5377,8 @@
char *ret;
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
} else {
@@ -5406,7 +5450,8 @@
Tcl_IncrRefCount(idxobj);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(nameobj);
Tcl_DecrRefCount(idxobj);
@@ -5471,7 +5516,8 @@
char *ret;
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
} else {
@@ -5568,7 +5614,8 @@
# endif
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(nameobj);
Tcl_DecrRefCount(valobj);
@@ -5635,7 +5682,8 @@
CONST char *ret;
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
} else {
@@ -5732,7 +5780,8 @@
Tcl_IncrRefCount(valobj);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(nameobj);
Tcl_DecrRefCount(idxobj);
@@ -5793,7 +5842,8 @@
CONST char *ret;
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
} else {
@@ -5837,7 +5887,8 @@
StringValue(varname);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return Qtrue;
}
@@ -5879,7 +5930,8 @@
StringValue(index);
/* ip is deleted? */
- if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)) {
+ if (Tcl_InterpDeleted(ptr->ip) || ip_null_namespace(ptr->ip)
+ || Tcl_GetCurrentNamespace(ptr->ip) != ptr->default_ns) {
DUMP1("ip is deleted");
return Qtrue;
}
--
永井 秀利 （九工大 知能情報）
nagai@ai.kyutech.ac.jp