1berry/ruby
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

* ext/tcltklib/tcltklib.c: improve control of preserv/release tcltkip

Browse Source 
* ext/tcltklib/tcltklib.c: store original 'exit' command
* ext/tk/tkutil.c: fix(?) SEGV


git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@6890 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
nagai 2004-09-12 16:05:59 +00:00
parent a472f971f0
commit 5bea219a9d
3 changed files with 216 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ChangeLog
View File

@ -1,3 +1,11 @@
Mon Sep 13 01:03:02 2004 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tcltklib/tcltklib.c: improve control of preserv/release tcltkip
* ext/tcltklib/tcltklib.c: store original 'exit' command
* ext/tk/tkutil.c: fix(?) SEGV
Mon Sep 13 00:22:53 2004 Minero Aoki <aamine@loveruby.net> Mon Sep 13 00:22:53 2004 Minero Aoki <aamine@loveruby.net>
* parse.y: fix file header. * parse.y: fix file header.

242
ext/tcltklib/tcltklib.c
View File

@ -197,6 +197,9 @@ static int ip_ruby_cmd _((ClientData, Tcl_Interp *, int, char **));
/*---- class TclTkIp ----*/ /*---- class TclTkIp ----*/
struct tcltkip { struct tcltkip {
Tcl_Interp *ip; /* the interpreter */ Tcl_Interp *ip; /* the interpreter */
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 */
int allow_ruby_exit; /* allow exiting ruby by 'exit' function */ int allow_ruby_exit; /* allow exiting ruby by 'exit' function */
int return_value; /* return value */ int return_value; /* return value */
}; };
@ -214,6 +217,102 @@ get_ip(self)
return ptr; return ptr;
} }
/* increment/decrement reference count of tcltkip */
static int
rbtk_preserve_ip(ptr)
struct tcltkip *ptr;
{
ptr->ref_count++;
Tcl_Preserve((ClientData)ptr->ip);
return(ptr->ref_count);
}
static int
rbtk_release_ip(ptr)
struct tcltkip *ptr;
{
ptr->ref_count--;
if (ptr->ref_count < 0) {
ptr->ref_count = 0;
} else {
Tcl_Release((ClientData)ptr->ip);
}
return(ptr->ref_count);
}
/* call original 'exit' command */
static void
call_original_exit(ptr, state)
struct tcltkip *ptr;
int state;
{
int thr_crit_bup;
Tcl_CmdInfo *info;
#if TCL_MAJOR_VERSION >= 8
Tcl_Obj *state_obj;
#endif
if (!(ptr->has_orig_exit)) return;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
Tcl_ResetResult(ptr->ip);
info = &(ptr->orig_exit_info);
/* memory allocation for arguments of this command */
#if TCL_MAJOR_VERSION >= 8
state_obj = Tcl_NewIntObj(state);
Tcl_IncrRefCount(state_obj);
if (info->isNativeObjectProc) {
Tcl_Obj **argv;
argv = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, 3);
argv[0] = Tcl_NewStringObj("exit", 4);
argv[1] = state_obj;
argv[2] = (Tcl_Obj *)NULL;
ptr->return_value
= (*(info->objProc))(info->objClientData, ptr->ip, 2, argv);
free(argv);
} else {
/* string interface */
char **argv;
argv = (char **)ALLOC_N(char *, 3);
argv[0] = "exit";
argv[1] = Tcl_GetString(state_obj);
argv[2] = (char *)NULL;
ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
2, (CONST84 char **)argv);
free(argv);
}
Tcl_DecrRefCount(state_obj);
#else /* TCL_MAJOR_VERSION < 8 */
{
/* string interface */
char **argv;
argv = (char **)ALLOC_N(char *, 3);
argv[0] = "exit";
argv[1] = RSTRING(rb_fix2str(INT2NUM(state), 10))->ptr;
argv[2] = (char *)NULL;
ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
2, argv);
free(argv);
}
#endif
rb_thread_critical = thr_crit_bup;
}
/* Tk_ThreadTimer */ /* Tk_ThreadTimer */
static Tcl_TimerToken timer_token = (Tcl_TimerToken)NULL; static Tcl_TimerToken timer_token = (Tcl_TimerToken)NULL;
@ -2967,7 +3066,6 @@ ip_thread_tkwait(self, mode, target)
return ip_invoke_real(3, argv, self); return ip_invoke_real(3, argv, self);
} }
/* destroy interpreter */ /* destroy interpreter */
VALUE del_root(ip) VALUE del_root(ip)
Tcl_Interp *ip; Tcl_Interp *ip;
@ -3064,7 +3162,8 @@ ip_free(ptr)
rb_thread_critical = Qtrue; rb_thread_critical = Qtrue;
if (!Tcl_InterpDeleted(ptr->ip)) { if (!Tcl_InterpDeleted(ptr->ip)) {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
delete_slaves(ptr->ip); delete_slaves(ptr->ip);
@ -3087,9 +3186,12 @@ ip_free(ptr)
Tcl_DeleteInterp(ptr->ip); Tcl_DeleteInterp(ptr->ip);
} }
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
} }
rbtk_release_ip(ptr);
free(ptr); free(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
@ -3127,15 +3229,23 @@ ip_init(argc, argv, self)
Data_Get_Struct(self, struct tcltkip, ptr); Data_Get_Struct(self, struct tcltkip, ptr);
ptr = ALLOC(struct tcltkip); ptr = ALLOC(struct tcltkip);
DATA_PTR(self) = ptr; DATA_PTR(self) = ptr;
ptr->ref_count = 0;
ptr->allow_ruby_exit = 1; ptr->allow_ruby_exit = 1;
ptr->return_value = 0; ptr->return_value = 0;
/* from Tk_Main() */ /* from Tk_Main() */
DUMP1("Tcl_CreateInterp"); DUMP1("Tcl_CreateInterp");
ptr->ip = Tcl_CreateInterp(); ptr->ip = Tcl_CreateInterp();
Tcl_Preserve((ClientData)ptr->ip); if (ptr->ip == NULL) {
rb_raise(rb_eRuntimeError, "fail to create a new Tk interpreter");
}
rbtk_preserve_ip((ClientData)ptr->ip);
current_interp = ptr->ip; current_interp = ptr->ip;
ptr->has_orig_exit
= Tcl_GetCommandInfo(ptr->ip, "exit", &(ptr->orig_exit_info));
/* from Tcl_AppInit() */ /* from Tcl_AppInit() */
DUMP1("Tcl_Init"); DUMP1("Tcl_Init");
if (Tcl_Init(ptr->ip) == TCL_ERROR) { if (Tcl_Init(ptr->ip) == TCL_ERROR) {
@ -3355,14 +3465,19 @@ ip_create_slave(argc, argv, self)
} }
/* create slave-ip */ /* create slave-ip */
slave->ref_count = 0;
slave->allow_ruby_exit = 0;
slave->return_value = 0;
slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe); slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe);
if (slave->ip == NULL) { if (slave->ip == NULL) {
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter"); rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter");
} }
Tcl_Preserve((ClientData)slave->ip); rbtk_preserve_ip(slave);
slave->allow_ruby_exit = 0;
slave->return_value = 0; slave->has_orig_exit
= Tcl_GetCommandInfo(slave->ip, "exit", &(slave->orig_exit_info));
/* replace 'exit' command --> 'interp_exit' command */ /* replace 'exit' command --> 'interp_exit' command */
mainWin = Tk_MainWindow(slave->ip); mainWin = Tk_MainWindow(slave->ip);
@ -3518,7 +3633,8 @@ ip_delete(self)
{ {
struct tcltkip *ptr = get_ip(self); struct tcltkip *ptr = get_ip(self);
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
if (!Tcl_InterpDeleted(ptr->ip)) { if (!Tcl_InterpDeleted(ptr->ip)) {
Tcl_Eval(ptr->ip, "foreach i [after info] { after cancel $i }"); Tcl_Eval(ptr->ip, "foreach i [after info] { after cancel $i }");
@ -3532,7 +3648,8 @@ ip_delete(self)
Tcl_DeleteInterp(ptr->ip); Tcl_DeleteInterp(ptr->ip);
} }
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
return Qnil; return Qnil;
} }
@ -3655,7 +3772,9 @@ ip_eval_real(self, cmd_str, cmd_len)
ptr->return_value = TCL_OK; ptr->return_value = TCL_OK;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ptr->return_value = Tcl_EvalObj(ptr->ip, cmd); ptr->return_value = Tcl_EvalObj(ptr->ip, cmd);
/* ptr->return_value = Tcl_GlobalEvalObj(ptr->ip, cmd); */ /* ptr->return_value = Tcl_GlobalEvalObj(ptr->ip, cmd); */
} }
@ -3668,7 +3787,9 @@ ip_eval_real(self, cmd_str, cmd_len)
volatile VALUE exc; volatile VALUE exc;
exc = create_ip_exc(self, rb_eRuntimeError, exc = create_ip_exc(self, rb_eRuntimeError,
"%s", Tcl_GetStringResult(ptr->ip)); "%s", Tcl_GetStringResult(ptr->ip));
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -3676,7 +3797,8 @@ ip_eval_real(self, cmd_str, cmd_len)
/* pass back the result (as string) */ /* pass back the result (as string) */
ret = ip_get_result_string_obj(ptr->ip); ret = ip_get_result_string_obj(ptr->ip);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return ret; return ret;
@ -3689,7 +3811,8 @@ ip_eval_real(self, cmd_str, cmd_len)
ptr->return_value = TCL_OK; ptr->return_value = TCL_OK;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ptr->return_value = Tcl_Eval(ptr->ip, cmd_str); ptr->return_value = Tcl_Eval(ptr->ip, cmd_str);
/* ptr->return_value = Tcl_GlobalEval(ptr->ip, cmd_str); */ /* ptr->return_value = Tcl_GlobalEval(ptr->ip, cmd_str); */
} }
@ -3697,14 +3820,16 @@ ip_eval_real(self, cmd_str, cmd_len)
if (ptr->return_value == TCL_ERROR) { if (ptr->return_value == TCL_ERROR) {
volatile VALUE exc; volatile VALUE exc;
exc = create_ip_exc(self, rb_eRuntimeError, "%s", ptr->ip->result); exc = create_ip_exc(self, rb_eRuntimeError, "%s", ptr->ip->result);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_exc_raise(exc); rb_exc_raise(exc);
} }
DUMP2("(TCL_Eval result) %d", ptr->return_value); DUMP2("(TCL_Eval result) %d", ptr->return_value);
/* pass back the result (as string) */ /* pass back the result (as string) */
ret = ip_get_result_string_obj(ptr->ip); ret = ip_get_result_string_obj(ptr->ip);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
return ret; return ret;
#endif #endif
} }
@ -3883,7 +4008,8 @@ lib_restart(self)
thr_crit_bup = rb_thread_critical; thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue; rb_thread_critical = Qtrue;
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
/* destroy the root wdiget */ /* destroy the root wdiget */
ptr->return_value = Tcl_Eval(ptr->ip, "destroy ."); ptr->return_value = Tcl_Eval(ptr->ip, "destroy .");
@ -3909,7 +4035,8 @@ lib_restart(self)
DUMP1("Tk_SafeInit"); DUMP1("Tk_SafeInit");
if (Tk_SafeInit(ptr->ip) == TCL_ERROR) { if (Tk_SafeInit(ptr->ip) == TCL_ERROR) {
exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip));
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -3917,7 +4044,8 @@ lib_restart(self)
DUMP1("Tk_Init"); DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) { if (Tk_Init(ptr->ip) == TCL_ERROR) {
exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip));
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -3926,12 +4054,14 @@ lib_restart(self)
DUMP1("Tk_Init"); DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) { if (Tk_Init(ptr->ip) == TCL_ERROR) {
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_exc_raise(exc); rb_exc_raise(exc);
} }
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
@ -4838,7 +4968,8 @@ ip_get_variable(self, varname_arg, flag_arg)
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_ObjGetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, ret = Tcl_ObjGetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL,
FIX2INT(flag)); FIX2INT(flag));
} }
@ -4852,7 +4983,8 @@ ip_get_variable(self, varname_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -4863,7 +4995,8 @@ ip_get_variable(self, varname_arg, flag_arg)
s = Tcl_GetStringFromObj(ret, &len); s = Tcl_GetStringFromObj(ret, &len);
strval = rb_tainted_str_new(s, len); strval = rb_tainted_str_new(s, len);
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -4881,7 +5014,8 @@ ip_get_variable(self, varname_arg, flag_arg)
} }
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -4896,7 +5030,8 @@ ip_get_variable(self, varname_arg, flag_arg)
DUMP1("ip is deleted"); DUMP1("ip is deleted");
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr, ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr,
(char*)NULL, FIX2INT(flag)); (char*)NULL, FIX2INT(flag));
} }
@ -4908,13 +5043,15 @@ ip_get_variable(self, varname_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
strval = rb_tainted_str_new2(ret); strval = rb_tainted_str_new2(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -4968,7 +5105,8 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_ObjGetVar2(ptr->ip, nameobj, idxobj, FIX2INT(flag)); ret = Tcl_ObjGetVar2(ptr->ip, nameobj, idxobj, FIX2INT(flag));
} }
@ -4982,7 +5120,8 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -4993,7 +5132,8 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
s = Tcl_GetStringFromObj(ret, &len); s = Tcl_GetStringFromObj(ret, &len);
strval = rb_tainted_str_new(s, len); strval = rb_tainted_str_new(s, len);
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5011,7 +5151,8 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
} }
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5026,7 +5167,8 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
DUMP1("ip is deleted"); DUMP1("ip is deleted");
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr, ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr,
RSTRING(index)->ptr, FIX2INT(flag)); RSTRING(index)->ptr, FIX2INT(flag));
} }
@ -5038,13 +5180,15 @@ ip_get_variable2(self, varname_arg, index_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
strval = rb_tainted_str_new2(ret); strval = rb_tainted_str_new2(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5123,7 +5267,8 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_ObjSetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, valobj, ret = Tcl_ObjSetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, valobj,
FIX2INT(flag)); FIX2INT(flag));
} }
@ -5138,7 +5283,8 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -5170,7 +5316,8 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5184,7 +5331,8 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
DUMP1("ip is deleted"); DUMP1("ip is deleted");
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, (char*)NULL, ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, (char*)NULL,
RSTRING(value)->ptr, (int)FIX2INT(flag)); RSTRING(value)->ptr, (int)FIX2INT(flag));
} }
@ -5194,7 +5342,8 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
} }
strval = rb_tainted_str_new2(ret); strval = rb_tainted_str_new2(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5283,7 +5432,8 @@ ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_ObjSetVar2(ptr->ip, nameobj, idxobj, valobj, ret = Tcl_ObjSetVar2(ptr->ip, nameobj, idxobj, valobj,
FIX2INT(flag)); FIX2INT(flag));
} }
@ -5299,7 +5449,8 @@ ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
#else /* TCL_MAJOR_VERSION < 8 */ #else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif #endif
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc); rb_exc_raise(exc);
} }
@ -5323,7 +5474,8 @@ ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
# endif # endif
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);
@ -5337,7 +5489,8 @@ ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
DUMP1("ip is deleted"); DUMP1("ip is deleted");
return rb_tainted_str_new2(""); return rb_tainted_str_new2("");
} else { } else {
Tcl_Preserve(ptr->ip); /* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr,
RSTRING(index)->ptr, RSTRING(index)->ptr,
RSTRING(value)->ptr, FIX2INT(flag)); RSTRING(value)->ptr, FIX2INT(flag));
@ -5352,7 +5505,8 @@ ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
strval = rb_tainted_str_new2(ret); strval = rb_tainted_str_new2(ret);
Tcl_DecrRefCount(ret); Tcl_DecrRefCount(ret);
Tcl_Release(ptr->ip); /* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup; rb_thread_critical = thr_crit_bup;
return(strval); return(strval);

10
ext/tk/tkutil.c
View File

@ -737,6 +737,13 @@ tk_conv_args(argc, argv, self)
{ {
int idx, size; int idx, size;
volatile VALUE dst; volatile VALUE dst;
int thr_crit_bup;
VALUE old_gc;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
old_gc = rb_gc_disable();
if (argc < 2) { if (argc < 2) {
rb_raise(rb_eArgError, "too few arguments"); rb_raise(rb_eArgError, "too few arguments");
@ -764,6 +771,9 @@ tk_conv_args(argc, argv, self)
} }
} }
if (old_gc == Qfalse) rb_gc_enable();
rb_thread_critical = thr_crit_bup;
return rb_ary_plus(argv[0], dst); return rb_ary_plus(argv[0], dst);
} }