From 51d360be64a371d036b1b6314f2afaefa7bbb701 Mon Sep 17 00:00:00 2001
From: nagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>
Date: Tue, 12 Apr 2005 03:40:27 +0000
Subject: * ext/tcltklib/tcltklib.c (ip_finalize): fix SEGV when
 Tcl_GlobalEval()   modifies the argument string to eval.

git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_8@8310 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
---
 ChangeLog               |  5 +++++
 ext/tcltklib/tcltklib.c | 28 ++++++++++++++++++----------
 2 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 4b705b06be..7cf72b4cf9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+Tue Apr 12 12:38:06 2005  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tcltklib/tcltklib.c (ip_finalize): fix SEGV when Tcl_GlobalEval()
+	  modifies the argument string to eval. 
+
 Tue Apr 12 02:21:55 2005  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
 
 	* ext/tcltklib/tcltklib.c (ip_finalize): add existence check of
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 407894c2d2..f598ed4a0d 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -4,7 +4,7 @@
  *              Oct. 24, 1997   Y. Matsumoto
  */
 
-#define TCLTKLIB_RELEASE_DATE "2005-03-30"
+#define TCLTKLIB_RELEASE_DATE "2005-04-12"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -4407,27 +4407,35 @@ ip_finalize(ip)
     delete_slaves(ip);
 
     /* delete root widget */
-    if ( Tcl_GetCommandInfo(ip, "catch", &info)
-         && Tcl_GetCommandInfo(ip, "destroy", &info) ) {
+    DUMP1("check `destroy'");
+    if (Tcl_GetCommandInfo(ip, "destroy", &info)) {
         DUMP1("call `destroy'");
-        Tcl_GlobalEval(ip, "catch {destroy .}");
+        Tcl_GlobalEval(ip, "destroy .");
     }
 
     /* call finalize-hook-proc */
+    DUMP1("check `finalize-hook-proc'");
     if (Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
         DUMP2("call finalize hook proc '%s'", finalize_hook_name);
         Tcl_GlobalEval(ip, finalize_hook_name);
     }
 
-    DUMP1("cancel after scripts");
+    DUMP1("cancel after callbacks");
+#define AFTER_CANCEL_CMD "foreach id [after info] {after cancel $id}"
     DUMP1("check `foreach' & `after'");
-    if ( Tcl_GetCommandInfo(ip, "catch", &info)
-         && Tcl_GetCommandInfo(ip, "foreach", &info)
+    if ( Tcl_GetCommandInfo(ip, "foreach", &info)
          && Tcl_GetCommandInfo(ip, "after", &info) ) {
-        DUMP1("call `foreach' & `after'");
-        Tcl_GlobalEval(ip, 
-                       "catch {foreach id [after info] {after cancel $id}}");
+        char *cmd;
+        if ((cmd = Tcl_Alloc(strlen(AFTER_CANCEL_CMD) + 1)) == (char*)NULL) {
+            DUMP1("cancel after callbacks : cannot allocate memory");
+        } else {
+            DUMP1("call `foreach' & `after'");
+            strcpy(cmd, AFTER_CANCEL_CMD);
+            Tcl_GlobalEval(ip, cmd);
+            Tcl_Free(cmd);
+        }
     }
+#undef AFTER_CANCEL_CMD
 
     Tcl_Release(ip);
 
-- 
cgit v1.2.3