* ext/tk/tcltklib.c: fix SEGV when embedding to an application.

[ruby-core:7600]
* ext/tk/tcltklib.c: fix SEGV at exit. [ruby-talk:186489]
* ext/tk/tkutil/tkutil.c: follow to changing specification of
  instance_eval on ruby-1.9.x.
* ext/tk/lib/tk.rb: ditto.
* ext/tk/lib/multi-tk.rb: ditto.
* ext/tk/lib/tk.rb: remove warning about redefinition of methods.
* ext/tk/lib/tk/variable.rb: remove warning about unseting Tcl
 variables.


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

ChangeLog

@@ -1,3 +1,22 @@
+Thu Apr  6 01:04:47 2006  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tk/tcltklib.c: fix SEGV when embedding to an application.
+	  [ruby-core:7600]
+
+	* ext/tk/tcltklib.c: fix SEGV at exit. [ruby-talk:186489]
+
+	* ext/tk/tkutil/tkutil.c: follow to changing specification of
+	  instance_eval on ruby-1.9.x.
+
+	* ext/tk/lib/tk.rb: ditto.
+
+	* ext/tk/lib/multi-tk.rb: ditto.
+
+	* ext/tk/lib/tk.rb: remove warning about redefinition of methods.
+
+	* ext/tk/lib/tk/variable.rb: remove warning about unseting Tcl
+	  variables.
+
 Wed Mar 29 20:54:44 2006  Masaki Suketa  <masaki.suketa@nifty.ne.jp>
 
 	* ext/win32ole/win32ole.c (fole_getproperty): WIN32OLE#[] should accept 

ext/tk/lib/multi-tk.rb

@@ -142,7 +142,7 @@ class MultiTkIp
 
   ######################################
 
-  @@CB_ENTRY_CLASS = Class.new(TkCallbackEntry){|c|
+  @@CB_ENTRY_CLASS = Class.new(TkCallbackEntry){
     def initialize(ip, cmd)
       @ip = ip
       @cmd = cmd

ext/tk/lib/tk.rb

@@ -1121,8 +1121,8 @@ module TkCore
       @init_ip_env  = [].taint  # table of Procs
       @add_tk_procs = [].taint  # table of [name, args, body]
 
-      @cb_entry_class = Class.new(TkCallbackEntry){|c|
+      @cb_entry_class = Class.new(TkCallbackEntry){
-        class << c
+        class << self
           def inspect
             sprintf("#<Class(TkCallbackEntry):%0x>", self.__id__)
           end
@@ -2310,13 +2310,17 @@ if (/^(8\.[1-9]|9\.|[1-9][0-9])/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK)
   end
 
   module TclTkLib
-    def self.encoding=(name)
+    class << self
+      alias _encoding encoding
+      alias _encoding= encoding=
+      def encoding=(name)
         TkCore::INTERP.encoding = name
       end
-    def self.encoding
+      def encoding
         TkCore::INTERP.encoding
       end
     end
+  end
 
   module Tk
     module Encoding
@@ -4555,7 +4559,7 @@ end
 #Tk.freeze
 
 module Tk
-  RELEASE_DATE = '2005-12-07'.freeze
+  RELEASE_DATE = '2006-04-06'.freeze
 
   autoload :AUTO_PATH,        'tk/variable'
   autoload :TCL_PACKAGE_PATH, 'tk/variable'

ext/tk/lib/tk/variable.rb

@@ -266,8 +266,11 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
 
   def initialize(val="", type=nil)
     # @id = Tk_VARIABLE_ID.join('')
+    begin
       @id = Tk_VARIABLE_ID.join(TkCore::INTERP._ip_id_)
       Tk_VARIABLE_ID[1].succ!
+    end until INTERP._invoke_without_enc('info', 'globals', @id).empty?
+
     TkVar_ID_TBL[@id] = self
 
     @var  = @id
@@ -286,11 +289,6 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
 
     self.default_value_type = type
 
-    begin
-      INTERP._unset_global_var(@id)
-    rescue
-    end
-
     # teach Tk-ip that @id is global var
     INTERP._invoke_without_enc('global', @id)
     #INTERP._invoke('global', @id)

ext/tk/tcltklib.c

@@ -4,7 +4,7 @@
  *              Oct. 24, 1997   Y. Matsumoto
  */
 
-#define TCLTKLIB_RELEASE_DATE "2005-12-07"
+#define TCLTKLIB_RELEASE_DATE "2006-04-06"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -1140,8 +1140,11 @@ set_max_block_time(self, time)
         tcl_time.usec = (long)(NUM2DBL(RARRAY(divmod)->ptr[1]) * 1000000);
 
     default:
+        {
+	    VALUE tmp = rb_funcall(time, ID_inspect, 0, 0);
 	    rb_raise(rb_eArgError, "invalid value for time: '%s'", 
-                 RSTRING(rb_funcall(time, ID_inspect, 0, 0))->ptr);
+		     StringValuePtr(tmp));
+	}
     }
 
     Tcl_SetMaxBlockTime(&tcl_time);
@@ -2132,6 +2135,7 @@ ip_set_exc_message(interp, exc)
     rb_thread_critical = Qtrue;
 
     msg = rb_funcall(exc, ID_message, 0, 0);
+    StringValue(msg);
 
 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
     enc = rb_attr_get(exc, ID_at_enc);
@@ -4355,12 +4359,13 @@ ip_finalize(ip)
 {
     Tcl_CmdInfo info;
     int  thr_crit_bup;
-    int  rb_debug_bup;  /* When ruby is exiting, printing debug messages in 
+
-                           some callback operations from Tcl-IP sometimes 
+    VALUE rb_debug_bup, rb_verbose_bup;
-                           cause SEGV. I don't know the reason. But I got 
+          /* When ruby is exiting, printing debug messages in some callback 
-                           SEGV when calling "rb_io_write(rb_stdout, ...)".
+             operations from Tcl-IP sometimes cause SEGV. I don't know the 
-                           So, in some part of this function, debug mode is 
+             reason. But I got SEGV when calling "rb_io_write(rb_stdout, ...)".
-                           disabled. If you know the reason, please fix it.
+             So, in some part of this function, debug mode and verbose mode 
+             are disabled. If you know the reason, please fix it.
                            --  Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp)  */
 
     DUMP1("start ip_finalize");
@@ -4370,6 +4375,11 @@ ip_finalize(ip)
         return;
     }
 
+    if (Tcl_InterpDeleted(ip)) {
+        DUMP2("ip(%lx) is already deleted", ip);
+        return;
+    }
+
 #if TCL_NAMESPACE_DEBUG
     if (ip_null_namespace(ip)) {
         DUMP2("ip(%lx) has null namespace", ip);
@@ -4381,6 +4391,7 @@ ip_finalize(ip)
     rb_thread_critical = Qtrue;
 
     rb_debug_bup   = ruby_debug;
+    rb_verbose_bup = ruby_verbose;
 
     Tcl_Preserve(ip);
 
@@ -4399,9 +4410,11 @@ ip_finalize(ip)
     DUMP1("destroy root widget");
     if (tk_stubs_init_p() && Tk_MainWindow(ip) != (Tk_Window)NULL) {
         DUMP1("call Tk_DestroyWindow");
-        ruby_debug = 0;
+        ruby_debug   = Qfalse;
+        ruby_verbose = Qnil;
         Tk_DestroyWindow(Tk_MainWindow(ip));
         ruby_debug   = rb_debug_bup;
+        ruby_verbose = rb_verbose_bup;
     }
 #endif
 
@@ -4409,24 +4422,29 @@ ip_finalize(ip)
     DUMP1("check `finalize-hook-proc'");
     if (Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
         DUMP2("call finalize hook proc '%s'", finalize_hook_name);
-        ruby_debug = 0;
+        ruby_debug   = Qfalse;
+        ruby_verbose = Qnil;
         Tcl_GlobalEval(ip, finalize_hook_name);
         ruby_debug   = rb_debug_bup;
+        ruby_verbose = rb_verbose_bup;
     }
 
     DUMP1("check `foreach' & `after'");
     if ( Tcl_GetCommandInfo(ip, "foreach", &info)
          && Tcl_GetCommandInfo(ip, "after", &info) ) {
         DUMP1("cancel after callbacks");
-        ruby_debug = 0;
+        ruby_debug   = Qfalse;
+        ruby_verbose = Qnil;
         Tcl_GlobalEval(ip, "foreach id [after info] {after cancel $id}");
         ruby_debug   = rb_debug_bup;
+        ruby_verbose = rb_verbose_bup;
     }
 
     Tcl_Release(ip);
 
     DUMP1("finish ip_finalize");
     ruby_debug   = rb_debug_bup;
+    ruby_verbose = rb_verbose_bup;
     rb_thread_critical = thr_crit_bup;
 }
 
@@ -4467,6 +4485,7 @@ ip_free(ptr)
         Tcl_DeleteInterp(ptr->ip); 
         Tcl_Release(ptr->ip); 
 
+        ptr->ip = (Tcl_Interp*)NULL;
         free(ptr);
 
         rb_thread_critical = thr_crit_bup;
@@ -4910,7 +4929,7 @@ ip_create_slave_core(interp, argc, argv)
     slave->allow_ruby_exit = 0;
     slave->return_value = 0;
 
-    slave->ip = Tcl_CreateSlave(master->ip, RSTRING(name)->ptr, safe);
+    slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe);
     if (slave->ip == NULL) {
         rb_thread_critical = thr_crit_bup;
         return rb_exc_new2(rb_eRuntimeError, 
@@ -6192,6 +6211,7 @@ lib_fromUTF8_core(ip_obj, src, encodename)
             char *s;
             int  len;
 
+            StringValue(str);
             s = Tcl_GetByteArrayFromObj(Tcl_NewStringObj(RSTRING(str)->ptr, 
                                                          RSTRING(str)->len), 
                                         &len);
@@ -6371,7 +6391,7 @@ lib_set_system_encoding(self, enc_name)
 
     enc_name = rb_funcall(enc_name, ID_to_s, 0, 0);
     if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL, 
-                              RSTRING(enc_name)->ptr) != TCL_OK) {
+                              StringValuePtr(enc_name)) != TCL_OK) {
         rb_raise(rb_eArgError, "unknown encoding name '%s'", 
                  RSTRING(enc_name)->ptr);
     }
@@ -7929,7 +7949,7 @@ Init_tcltklib()
 
     /* --------------------------------------------------------------- */
 
-    ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
+    ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING(rb_argv0)->ptr : 0);
     switch(ret) {
     case TCLTK_STUBS_OK:
         break;

ext/tk/tkutil/tkutil.c

@@ -8,10 +8,11 @@
 
 ************************************************/
 
-#define TKUTIL_RELEASE_DATE "2005-11-07"
+#define TKUTIL_RELEASE_DATE "2006-04-06"
 
 #include "ruby.h"
 #include "rubysig.h"
+#include "version.h"
 #include "st.h"
 
 static VALUE cMethod;
@@ -57,7 +58,13 @@ tk_s_new(argc, argv, klass)
 {
     VALUE obj = rb_class_new_instance(argc, argv, klass);
 
-    if (rb_block_given_p()) rb_obj_instance_eval(0, 0, obj);
+    if (rb_block_given_p()) {
+#if RUBY_VERSION_MAJOR == 1 && RUBY_VERSION_MINOR <= 8 /* ruby 1.8.x */
+      rb_obj_instance_eval(0, 0, obj);
+#else
+      rb_obj_instance_exec(1, &obj, obj);
+#endif
+    }
     return obj;
 }