summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-11-19 22:23:08 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-11-19 22:23:08 (GMT)
commitc96b49ed88b11232f11d79f859e6b62418c5c10a (patch)
tree3127a144602ef0cb05795cd722659052d0388891 /generic
parent9d8f556865a0a282039621759755c0cf44664039 (diff)
parent094f23c172acca8f32b0888cd536f01fc1daab1b (diff)
downloadtcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.zip
tcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.tar.gz
tcl-c96b49ed88b11232f11d79f859e6b62418c5c10a.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c49
-rw-r--r--generic/tclCmdIL.c39
-rw-r--r--generic/tclExecute.c3
-rw-r--r--generic/tclTest.c2
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 = {