diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-19 22:23:08 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-19 22:23:08 (GMT) |
commit | c96b49ed88b11232f11d79f859e6b62418c5c10a (patch) | |
tree | 3127a144602ef0cb05795cd722659052d0388891 /generic | |
parent | 9d8f556865a0a282039621759755c0cf44664039 (diff) | |
parent | 094f23c172acca8f32b0888cd536f01fc1daab1b (diff) | |
download | tcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.zip tcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.tar.gz tcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 49 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 39 | ||||
-rw-r--r-- | generic/tclExecute.c | 3 | ||||
-rw-r--r-- | generic/tclTest.c | 2 |
4 files changed, 50 insertions, 43 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index bce6479..562cca6 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3756,41 +3756,28 @@ Tcl_ListMathFuncs( Tcl_Interp *interp, const char *pattern) { - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); - Namespace *nsPtr; - Namespace *dummy1NsPtr; - Namespace *dummy2NsPtr; - const char *dummyNamePtr; - Tcl_Obj *result = Tcl_NewObj(); - - TclGetNamespaceForQualName(interp, "::tcl::mathfunc", - globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY, - &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr); - if (nsPtr == NULL) { - return result; + Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); + Tcl_Obj *result; + Tcl_InterpState state; + + if (pattern) { + Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); + Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); + + Tcl_AppendObjToObj(script, arg); + Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ } - if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(pattern, -1)); - } + state = Tcl_SaveInterpState(interp, TCL_OK); + Tcl_IncrRefCount(script); + if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { + result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { - Tcl_HashSearch cmdHashSearch; - Tcl_HashEntry *cmdHashEntry = - Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch); - - for (; cmdHashEntry != NULL; - cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) { - const char *cmdNamePtr = - Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry); - - if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(cmdNamePtr, -1)); - } - } + result = Tcl_NewObj(); } + Tcl_DecrRefCount(script); + Tcl_RestoreInterpState(interp, state); + return result; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 7be017d..155e8e4 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1492,19 +1492,42 @@ InfoFunctionsCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *pattern; + Tcl_Obj *script; + int code; - if (objc == 1) { - pattern = NULL; - } else if (objc == 2) { - pattern = TclGetString(objv[1]); - } else { + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_ListMathFuncs(interp, pattern)); - return TCL_OK; + script = Tcl_NewStringObj( +" ::apply [::list {{pattern *}} {\n" +" ::set cmds {}\n" +" ::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n" +" ::lappend cmds [::namespace tail $cmd]\n" +" }\n" +" ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n" +" ::set cmd [::namespace tail $cmd]\n" +" ::if {$cmd ni $cmds} {\n" +" ::lappend cmds $cmd\n" +" }\n" +" }\n" +" ::return $cmds\n" +" } [::namespace current]] ", -1); + + if (objc == 2) { + Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1])); + + Tcl_AppendObjToObj(script, arg); + Tcl_DecrRefCount(arg); + } + + Tcl_IncrRefCount(script); + code = Tcl_EvalObjEx(interp, script, 0); + + Tcl_DecrRefCount(script); + + return code; } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index cf8f9e7..2b5f713 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4962,9 +4962,6 @@ TEBCresume( } if (toIdx < -1) { toIdx += 1 + length; - if (toIdx < 0) { - toIdx = 0; - } } else if (toIdx >= length) { toIdx = length - 1; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 1734968..a8b27fb 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -415,7 +415,7 @@ static int TestInterpResolverCmd(ClientData clientData, #if defined(HAVE_CPUID) || defined(__WIN32__) static int TestcpuidCmd(ClientData dummy, Tcl_Interp* interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); #endif static const Tcl_Filesystem testReportingFilesystem = { |