summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2012-11-16 16:19:54 (GMT)
committerdgp <dgp@users.sourceforge.net>2012-11-16 16:19:54 (GMT)
commit2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95 (patch)
treeb9d6e4c30112049fb102fc3f80bfe43375e5d21a /generic
parenta5e261f15f06a283ad8a648611f1a9eb5b8127e1 (diff)
parent10dd9595a33e80ac7ab8ae5ff11b6b6ef3059b20 (diff)
downloadtcl-2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95.zip
tcl-2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95.tar.gz
tcl-2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95.tar.bz2
3587651 Fix [info functions] and Tcl_ListMathFuncs().
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c49
-rw-r--r--generic/tclCmdIL.c39
2 files changed, 49 insertions, 39 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;
}
/*