diff options
author | usa <usa@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2015-05-12 07:15:23 +0000 |
---|---|---|
committer | usa <usa@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2015-05-12 07:15:23 +0000 |
commit | dd4cf6bbeb4ae5dd03d9b6cb3c2a4e73e2ab8b34 (patch) | |
tree | 37ea7e7600d60f07a8b931e624c321c8ca0693da /ext | |
parent | 14c7be2e5a5738b7f5fa55bc9cefd43a2e8a02d2 (diff) |
* ext/tk/extconf.rb: support Tcl/Tk8.6.
* ext/tk/tcltklib.c, ext/tk/lib/tk.rb: get rid of SEGV with Tcl/Tk8.6.
[Backport #10401]
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_2_1@50474 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext')
-rw-r--r-- | ext/tk/extconf.rb | 4 | ||||
-rw-r--r-- | ext/tk/lib/tk.rb | 18 | ||||
-rw-r--r-- | ext/tk/tcltklib.c | 71 |
3 files changed, 82 insertions, 11 deletions
diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb index 6e2ddb79e6..00980ddaff 100644 --- a/ext/tk/extconf.rb +++ b/ext/tk/extconf.rb @@ -9,10 +9,10 @@ TkLib_Config['search_versions'] = # %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 --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index 5bac92e47c..65ab57311e 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -1309,8 +1309,12 @@ EOS 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 @@ EOS 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 --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c index 237462fc3b..22e2676bb8 100644 --- a/ext/tk/tcltklib.c +++ b/ext/tk/tcltklib.c @@ -6012,7 +6012,12 @@ ip_rbNamespaceObjCmd(clientData, interp, objc, objv) 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 @@ ip_rbNamespaceObjCmd(clientData, interp, objc, objv) } 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 @@ ip_rbNamespaceObjCmd(clientData, interp, objc, objv) #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 @@ ip_wrap_namespace_command(interp) 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 @@ ip_wrap_namespace_command(interp) 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 @@ invoke_tcl_proc(arg) #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 @@ invoke_tcl_proc(arg) } #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 @@ invoke_tcl_proc(arg) 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 @@ invoke_tcl_proc(arg) #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 @@ ip_invoke_core(interp, argc, argv) #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())) { |