diff -urN ruby-2.1.3.orig/ext/tk/extconf.rb ruby-2.1.3.for-SEGV-only/ext/tk/extconf.rb --- ruby-2.1.3.orig/ext/tk/extconf.rb 2013-11-30 11:46:47.000000000 +0900 +++ ruby-2.1.3.for-SEGV-only/ext/tk/extconf.rb 2014-10-19 17:50:33.045820645 +0900 @@ -9,10 +9,10 @@ # %w[8.9 8.8 8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0 7.6 4.2] # %w[8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0] # %w[8.7 8.6 8.5 8.4 8.0] # to shorten search steps - %w[8.5 8.4] # At present, Tcl/Tk8.6 is not supported. + %w[8.6 8.5 8.4] TkLib_Config['unsupported_versions'] = - %w[8.8 8.7 8.6] # At present, Tcl/Tk8.6 is not supported. + %w[8.8 8.7] TkLib_Config['major_nums'] = '87' diff -urN ruby-2.1.3.orig/ext/tk/lib/tk.rb ruby-2.1.3.for-SEGV-only/ext/tk/lib/tk.rb --- ruby-2.1.3.orig/ext/tk/lib/tk.rb 2011-05-27 08:36:33.000000000 +0900 +++ ruby-2.1.3.for-SEGV-only/ext/tk/lib/tk.rb 2014-10-24 02:59:04.482665787 +0900 @@ -1309,8 +1309,12 @@ end unless interp.deleted? - #Thread.current[:status].value = TclTkLib.mainloop(false) - Thread.current[:status].value = interp.mainloop(false) + begin + #Thread.current[:status].value = TclTkLib.mainloop(false) + Thread.current[:status].value = interp.mainloop(false) + rescue Exception=>e + puts "ignore exception on interp: #{e.inspect}\n" if $DEBUG + end end ensure @@ -1569,7 +1573,15 @@ EOL =end - at_exit{ INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) } + if !WITH_RUBY_VM || RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! + at_exit{ INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) } + else + at_exit{ + Tk.root.destroy + INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) + INTERP_THREAD.kill.join + } + end EventFlag = TclTkLib::EventFlag diff -urN ruby-2.1.3.orig/ext/tk/tcltklib.c ruby-2.1.3.for-SEGV-only/ext/tk/tcltklib.c --- ruby-2.1.3.orig/ext/tk/tcltklib.c 2014-02-10 20:45:14.000000000 +0900 +++ ruby-2.1.3.for-SEGV-only/ext/tk/tcltklib.c 2014-10-19 19:17:00.014057636 +0900 @@ -6012,7 +6012,12 @@ Tcl_CmdInfo info; int ret; + DUMP1("call ip_rbNamespaceObjCmd"); + DUMP2("objc = %d", objc); + DUMP2("objv[0] = '%s'", Tcl_GetString(objv[0])); + DUMP2("objv[1] = '%s'", Tcl_GetString(objv[1])); if (!Tcl_GetCommandInfo(interp, "__orig_namespace_command__", &(info))) { + DUMP1("fail to get __orig_namespace_command__"); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "invalid command name \"namespace\"", (char*)NULL); @@ -6020,15 +6025,38 @@ } rbtk_eventloop_depth++; - /* DUMP2("namespace wrapper enter depth == %d", rbtk_eventloop_depth); */ + DUMP2("namespace wrapper enter depth == %d", rbtk_eventloop_depth); if (info.isNativeObjectProc) { +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6 + DUMP1("call a native-object-proc"); ret = (*(info.objProc))(info.objClientData, interp, objc, objv); +#else + /* Tcl8.6 or later */ + int i; + Tcl_Obj **cp_objv; + char org_ns_cmd_name[] = "__orig_namespace_command__"; + + DUMP1("call a native-object-proc for tcl8.6 or later"); + cp_objv = RbTk_ALLOC_N(Tcl_Obj *, (objc + 1)); + + cp_objv[0] = Tcl_NewStringObj(org_ns_cmd_name, strlen(org_ns_cmd_name)); + for(i = 1; i < objc; i++) { + cp_objv[i] = objv[i]; + } + cp_objv[objc] = (Tcl_Obj *)NULL; + + /* ret = Tcl_EvalObjv(interp, objc, cp_objv, TCL_EVAL_DIRECT); */ + ret = Tcl_EvalObjv(interp, objc, cp_objv, 0); + + ckfree((char*)cp_objv); +#endif } else { /* string interface */ int i; char **argv; + DUMP1("call with the string-interface"); /* argv = (char **)Tcl_Alloc(sizeof(char *) * (objc + 1)); */ argv = RbTk_ALLOC_N(char *, (objc + 1)); #if 0 /* use Tcl_Preserve/Release */ @@ -6056,9 +6084,10 @@ #endif } - /* DUMP2("namespace wrapper exit depth == %d", rbtk_eventloop_depth); */ + DUMP2("namespace wrapper exit depth == %d", rbtk_eventloop_depth); rbtk_eventloop_depth--; + DUMP1("end of ip_rbNamespaceObjCmd"); return ret; } #endif @@ -6068,6 +6097,8 @@ Tcl_Interp *interp; { #if TCL_MAJOR_VERSION >= 8 + +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6 Tcl_CmdInfo orig_info; if (!Tcl_GetCommandInfo(interp, "namespace", &(orig_info))) { @@ -6084,6 +6115,11 @@ orig_info.deleteProc); } +#else /* tcl8.6 or later */ + Tcl_GlobalEval(interp, "rename namespace __orig_namespace_command__"); + +#endif + Tcl_CreateObjCommand(interp, "namespace", ip_rbNamespaceObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL); #endif @@ -8448,15 +8484,28 @@ #endif { struct invoke_info *inf = (struct invoke_info *)arg; + +#if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION < 6 int i, len; -#if TCL_MAJOR_VERSION >= 8 int argc = inf->objc; char **argv = (char **)NULL; #endif + DUMP1("call invoke_tcl_proc"); + +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 6) + + /* eval */ + inf->ptr->return_value = Tcl_EvalObjv(inf->ptr->ip, inf->objc, inf->objv, TCL_EVAL_DIRECT); + /* inf->ptr->return_value = Tcl_EvalObjv(inf->ptr->ip, inf->objc, inf->objv, 0); */ + +#else /* Tcl/Tk 7.x, 8.0 -- 8.5 */ + /* memory allocation for arguments of this command */ -#if TCL_MAJOR_VERSION >= 8 +#if TCL_MAJOR_VERSION == 8 + /* Tcl/Tk 8.0 -- 8.5 */ if (!inf->cmdinfo.isNativeObjectProc) { + DUMP1("called proc is not a native-obj-proc"); /* string interface */ /* argv = (char **)ALLOC_N(char *, argc+1);*/ /* XXXXXXXXXX */ argv = RbTk_ALLOC_N(char *, (argc+1)); @@ -8470,11 +8519,14 @@ } #endif + DUMP1("reset result of tcl-interp"); Tcl_ResetResult(inf->ptr->ip); /* Invoke the C procedure */ -#if TCL_MAJOR_VERSION >= 8 +#if TCL_MAJOR_VERSION == 8 + /* Tcl/Tk 8.0 -- 8.5 */ if (inf->cmdinfo.isNativeObjectProc) { + DUMP1("call tcl_proc as a native-obj-proc"); inf->ptr->return_value = (*(inf->cmdinfo.objProc))(inf->cmdinfo.objClientData, inf->ptr->ip, inf->objc, inf->objv); @@ -8482,7 +8534,9 @@ else #endif { -#if TCL_MAJOR_VERSION >= 8 +#if TCL_MAJOR_VERSION == 8 + /* Tcl/Tk 8.0 -- 8.5 */ + DUMP1("call tcl_proc as not a native-obj-proc"); inf->ptr->return_value = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, argc, (CONST84 char **)argv); @@ -8505,6 +8559,9 @@ #endif } +#endif /* Tcl/Tk 8.6 or later || Tcl 7.x, 8.0 -- 8.5 */ + + DUMP1("end of invoke_tcl_proc"); return Qnil; } @@ -8644,7 +8701,9 @@ #endif /* invoke tcl-proc */ + DUMP1("invoke tcl-proc"); rb_protect(invoke_tcl_proc, (VALUE)&inf, &status); + DUMP2("status of tcl-proc, %d", status); switch(status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) {