diff options
| author | nagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2004-12-27 11:04:21 +0000 |
|---|---|---|
| committer | nagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2004-12-27 11:04:21 +0000 |
| commit | 53c584d35db576377c4aa803c8f5a28c2d52eede (patch) | |
| tree | 94b16e51f49d5dfb802a38c9cd585e425c0c876e /ext/tcltklib | |
| parent | 8768030bb6b217de19158f54421dfd34d0dfaa80 (diff) | |
| download | ruby-53c584d35db576377c4aa803c8f5a28c2d52eede.tar.gz | |
* ext/tcltklib/tcltklib.c: fix SEGV bug when deleting Tk interp
* ext/tk/lib/multi-tk.rb: ditto
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@7667 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext/tcltklib')
| -rw-r--r-- | ext/tcltklib/tcltklib.c | 48 |
1 files changed, 30 insertions, 18 deletions
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index 6184d73880..a52994dd00 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -4,7 +4,7 @@ * Oct. 24, 1997 Y. Matsumoto */ -#define TCLTKLIB_RELEASE_DATE "2004-12-23" +#define TCLTKLIB_RELEASE_DATE "2004-12-27" #include "ruby.h" #include "rubysig.h" @@ -70,9 +70,13 @@ fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); } /* release date */ const char tcltklib_release_date[] = TCLTKLIB_RELEASE_DATE; -/*finalize_proc_name */ +/* finalize_proc_name */ static char *finalize_hook_name = "INTERP_FINALIZE_HOOK"; +/* to cancel remained after-scripts when deleting IP */ +#define REMAINED_AFTER_IDS_VAR "__ruby_tcltklib_remained_after_script_list__" +#define CANCEL_REMAINED_AFTER_IDS "foreach id $__ruby_tcltklib_remained_after_script_list__ {after cancel $id}" + /* for callback break & continue */ static VALUE eTkCallbackReturn; static VALUE eTkCallbackBreak; @@ -3312,12 +3316,16 @@ delete_slaves(ip) Tcl_Preserve(slave); -#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4) -#else if (!Tcl_InterpDeleted(slave)) { - Tcl_Eval(slave, "foreach i [after info] { after cancel $i }"); + if (Tcl_Eval(slave, "after info") == TCL_OK + && Tcl_SetVar(slave, + REMAINED_AFTER_IDS_VAR, + Tcl_GetStringResult(slave), + TCL_GLOBAL_ONLY) != (char *)NULL) { + DUMP1("cancel after scripts"); + Tcl_Eval(slave, CANCEL_REMAINED_AFTER_IDS); + } } -#endif /* delete slaves of slave */ delete_slaves(slave); @@ -3360,18 +3368,20 @@ ip_free(ptr) Tcl_ResetResult(ptr->ip); + if (Tcl_Eval(ptr->ip, "after info") == TCL_OK + && Tcl_SetVar(ptr->ip, + REMAINED_AFTER_IDS_VAR, + Tcl_GetStringResult(ptr->ip), + TCL_GLOBAL_ONLY) != (char *)NULL) { + DUMP1("cancel after scripts"); + Tcl_Eval(ptr->ip, CANCEL_REMAINED_AFTER_IDS); + } + 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); } -#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4) -#else - if (!Tcl_InterpDeleted(ptr->ip)) { - Tcl_Eval(ptr->ip, "foreach i [after info] {after cancel $i}"); - } -#endif - del_root(ptr->ip); DUMP1("delete interp"); @@ -3838,12 +3848,14 @@ ip_delete(self) /* Tcl_Preserve(ptr->ip); */ rbtk_preserve_ip(ptr); -#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4) -#else - if (!Tcl_InterpDeleted(ptr->ip)) { - Tcl_Eval(ptr->ip, "foreach i [after info] { after cancel $i }"); + if (Tcl_Eval(ptr->ip, "after info") == TCL_OK + && Tcl_SetVar(ptr->ip, + REMAINED_AFTER_IDS_VAR, + Tcl_GetStringResult(ptr->ip), + TCL_GLOBAL_ONLY) != (char *)NULL) { + DUMP1("cancel after scripts"); + Tcl_Eval(ptr->ip, CANCEL_REMAINED_AFTER_IDS); } -#endif del_root(ptr->ip); |