* ext/tk/tcltklib.c (ip_finalize): better modification than the

  previous commit [ruby-dev:26029].


git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@8312 b2dd03c8-39d4-4d8f-98ff-823fe69b080e

1 files changed, 32 insertions, 12 deletions

diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c
index f598ed4a0d..49667427f5 100644
--- a/ext/tk/tcltklib.c
+++ b/ext/tk/tcltklib.c
@@ -115,6 +115,36 @@ static VALUE ip_invoke _((int, VALUE*, VALUE));
 static VALUE tk_funcall _((VALUE(), int, VALUE*, VALUE));
 
 
+/* safe Tcl_Eval and Tcl_GlobalEval */
+static int
+tcl_eval(interp, cmd)
+    Tcl_Interp *interp;
+    const char *cmd; /* don't have to be writable */
+{
+    char *buf = strdup(cmd);
+    const int ret = Tcl_Eval(interp, buf);
+    free(buf);
+    return ret;
+}
+
+#undef Tcl_Eval
+#define Tcl_Eval tcl_eval
+
+static int
+tcl_global_eval(interp, cmd)
+    Tcl_Interp *interp;
+    const char *cmd; /* don't have to be writable */
+{
+    char *buf = strdup(cmd);
+    const int ret = Tcl_GlobalEval(interp, buf);
+    free(buf);
+    return ret;
+}
+
+#undef Tcl_GlobalEval
+#define Tcl_GlobalEval tcl_global_eval
+
+
 /* from tkAppInit.c */
 
 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
@@ -4420,22 +4450,12 @@ ip_finalize(ip)
         Tcl_GlobalEval(ip, finalize_hook_name);
     }
 
-    DUMP1("cancel after callbacks");
-#define AFTER_CANCEL_CMD "foreach id [after info] {after cancel $id}"
     DUMP1("check `foreach' & `after'");
     if ( Tcl_GetCommandInfo(ip, "foreach", &info)
          && Tcl_GetCommandInfo(ip, "after", &info) ) {
-        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);
-        }
+        DUMP1("cancel after callbacks");
+        Tcl_GlobalEval(ip, "foreach id [after info] {after cancel $id}");
     }
-#undef AFTER_CANCEL_CMD
 
     Tcl_Release(ip);