* ext/tk/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/trunk@8309 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
nagai 2005-04-12 03:39:50 +00:00
parent f5af202262
commit b346101b25
2 changed files with 20 additions and 9 deletions

View File

@ -1,3 +1,8 @@
Tue Apr 12 12:38:06 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tk/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> Tue Apr 12 02:21:55 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tk/tcltklib.c (ip_finalize): add existence check of * ext/tk/tcltklib.c (ip_finalize): add existence check of

View File

@ -4,7 +4,7 @@
* Oct. 24, 1997 Y. Matsumoto * Oct. 24, 1997 Y. Matsumoto
*/ */
#define TCLTKLIB_RELEASE_DATE "2005-03-30" #define TCLTKLIB_RELEASE_DATE "2005-04-12"
#include "ruby.h" #include "ruby.h"
#include "rubysig.h" #include "rubysig.h"
@ -4408,10 +4408,9 @@ ip_finalize(ip)
/* delete root widget */ /* delete root widget */
DUMP1("check `destroy'"); DUMP1("check `destroy'");
if ( Tcl_GetCommandInfo(ip, "catch", &info) if (Tcl_GetCommandInfo(ip, "destroy", &info)) {
&& Tcl_GetCommandInfo(ip, "destroy", &info) ) {
DUMP1("call `destroy'"); DUMP1("call `destroy'");
Tcl_GlobalEval(ip, "catch {destroy .}"); Tcl_GlobalEval(ip, "destroy .");
} }
/* call finalize-hook-proc */ /* call finalize-hook-proc */
@ -4422,14 +4421,21 @@ ip_finalize(ip)
} }
DUMP1("cancel after callbacks"); DUMP1("cancel after callbacks");
#define AFTER_CANCEL_CMD "foreach id [after info] {after cancel $id}"
DUMP1("check `foreach' & `after'"); DUMP1("check `foreach' & `after'");
if ( Tcl_GetCommandInfo(ip, "catch", &info) if ( Tcl_GetCommandInfo(ip, "foreach", &info)
&& Tcl_GetCommandInfo(ip, "foreach", &info)
&& Tcl_GetCommandInfo(ip, "after", &info) ) { && Tcl_GetCommandInfo(ip, "after", &info) ) {
DUMP1("call `foreach' & `after'"); char *cmd;
Tcl_GlobalEval(ip, if ((cmd = Tcl_Alloc(strlen(AFTER_CANCEL_CMD) + 1)) == (char*)NULL) {
"catch {foreach id [after info] {after cancel $id}}"); 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); Tcl_Release(ip);