summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2004-12-27 11:04:21 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2004-12-27 11:04:21 +0000
commit53c584d35db576377c4aa803c8f5a28c2d52eede (patch)
tree94b16e51f49d5dfb802a38c9cd585e425c0c876e /ext
parent8768030bb6b217de19158f54421dfd34d0dfaa80 (diff)
* 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')
-rw-r--r--ext/tcltklib/tcltklib.c48
-rw-r--r--ext/tk/lib/multi-tk.rb30
-rw-r--r--ext/tk/lib/tk.rb2
3 files changed, 53 insertions, 27 deletions
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 6184d73880d..a52994dd008 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 f44f576626c..d292b5089d7 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 ab0c1a098ba..9dae5f0899c 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'