From 53c584d35db576377c4aa803c8f5a28c2d52eede Mon Sep 17 00:00:00 2001 From: nagai Date: Mon, 27 Dec 2004 11:04:21 +0000 Subject: * 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 --- ChangeLog | 6 ++++++ ext/tcltklib/tcltklib.c | 48 ++++++++++++++++++++++++++++++------------------ ext/tk/lib/multi-tk.rb | 30 ++++++++++++++++++++++-------- ext/tk/lib/tk.rb | 2 +- 4 files changed, 59 insertions(+), 27 deletions(-) diff --git a/ChangeLog b/ChangeLog index 20eb0b8dc7..309807d3a3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +Mon Dec 27 20:02:14 2004 Hidetoshi NAGAI + + * ext/tcltklib/tcltklib.c: fix SEGV bug when deleting Tk interp + + * ext/tk/lib/multi-tk.rb: ditto + Mon Dec 27 16:54:05 2004 GOTOU Yuuzou * ext/openssl/ossl_x509name.c (Init_ossl_x509name): should use 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); diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb index f44f576626..d292b5089d 100644 --- a/ext/tk/lib/multi-tk.rb +++ b/ext/tk/lib/multi-tk.rb @@ -189,7 +189,9 @@ class MultiTkIp unless ip.deleted? ip._split_tklist(ip._invoke('interp', 'slaves')).each{|name| begin - ip._eval_without_enc("#{name} eval {foreach i [after info] {after cancel $i}}") + # ip._eval_without_enc("#{name} eval {foreach i [after info] {after cancel $i}}") + after_ids = ip._eval_without_enc("#{name} eval {after info}") + ip._eval_without_enc("#{name} eval {foreach i {#{after_ids}} {after cancel $i}}") rescue Exception end begin @@ -236,7 +238,9 @@ class MultiTkIp @slave_ip_tbl.each{|name, subip| _destroy_slaves_of_slaveIP(subip) begin - subip._eval_without_enc("foreach i [after info] {after cancel $i}") + # subip._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = subip._eval_without_enc("after info") + subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end =begin @@ -270,7 +274,9 @@ class MultiTkIp } begin - @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = @interp._eval_without_enc("after info") + @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end begin @@ -310,7 +316,9 @@ class MultiTkIp @slave_ip_tbl.each{|name, subip| _destroy_slaves_of_slaveIP(subip) begin - subip._eval_without_enc("foreach i [after info] {after cancel $i}") + # subip._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = subip._eval_without_enc("after info") + subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end =begin @@ -344,7 +352,9 @@ class MultiTkIp } begin - @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = @interp._eval_without_enc("after info") + @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end =begin @@ -1315,7 +1325,7 @@ class MultiTkIp @cmd_queue.enq([nil, cmd, *args]) rescue Exception => e # ignore - if $DEBUG || true + if $DEBUG warn("Warning: " + e.class.inspect + ((e.message.length > 0)? ' "' + e.message + '"': '') + " on " + self.inspect) @@ -1821,7 +1831,9 @@ class MultiTkIp end =end begin - subip._eval_without_enc("foreach i [after info] {after cancel $i}") + # subip._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = subip._eval_without_enc("after info") + subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end @@ -1850,7 +1862,9 @@ class MultiTkIp } begin - @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") + after_ids = @interp._eval_without_enc("after info") + @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") rescue Exception end =begin diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index ab0c1a098b..9dae5f0899 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -3940,7 +3940,7 @@ end #Tk.freeze module Tk - RELEASE_DATE = '2004-12-24'.freeze + RELEASE_DATE = '2004-12-27'.freeze autoload :AUTO_PATH, 'tk/variable' autoload :TCL_PACKAGE_PATH, 'tk/variable' -- cgit v1.2.3