[ruby-dev:25353] tcltklib patch (Re: リリース準備)

永井@知能．九工大です．

> 処理がよくわかっていないので場当たり的ですが、下のように順番を変えても
> 落ちなくなりました。想像ですが、ファイナライザを呼んだ後
> foreach i [after info] {after cancel $i} を呼ぶと落ちるんじゃないでしょうか。
> それだと bcc32 だけ落ちる理由にならないような気もしますが・・・

コマンドライン埋め込みの展開を行おうとすると落ちるようです．
以下のパッチではいかがでしょうか？

Index: ext/tcltklib/tcltklib.c
===================================================================
RCS file: /var/cvs/src/ruby/ext/tcltklib/tcltklib.c,v
retrieving revision 1.49.2.23
diff -u -r1.49.2.23 tcltklib.c
--- ext/tcltklib/tcltklib.c	23 Dec 2004 04:16:42 -0000	1.49.2.23
+++ ext/tcltklib/tcltklib.c	27 Dec 2004 08:29:47 -0000
@@ -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 @@
 /* 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 @@
 
         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 @@
 
             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 @@
     /* 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);
 
@@ -4188,6 +4200,7 @@
         rb_thread_stop();
     }
     DUMP2("back from handler (current thread:%lx)", current);
+    DUMP1("ip_eval back:111");
 
     /* get result & free allocated memory */
     ret = RARRAY(result)->ptr[0];
Index: ext/tk/lib/multi-tk.rb
===================================================================
RCS file: /var/cvs/src/ruby/ext/tk/lib/multi-tk.rb,v
retrieving revision 1.17.2.18
diff -u -r1.17.2.18 multi-tk.rb
--- ext/tk/lib/multi-tk.rb	20 Dec 2004 05:10:33 -0000	1.17.2.18
+++ ext/tk/lib/multi-tk.rb	27 Dec 2004 08:29:48 -0000
@@ -189,7 +189,9 @@
     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 @@
         @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 @@
         }
 
         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 @@
           @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 @@
           }
 
           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 @@
         @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 @@
       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 @@
     }
 
     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

-- 
                                       永井 秀利 （九工大 知能情報）
                                           [e-mail]