Attachment "tip15.patch" to
ticket [426942ffff]
added by
dkf
2001-05-29 22:29:51.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.449
diff -u -r1.449 ChangeLog
--- ChangeLog 2001/05/23 23:23:02 1.449
+++ ChangeLog 2001/05/24 14:14:25
@@ -1,3 +1,13 @@
+2001-05-24 Donal K. Fellows <[email protected]>
+
+ * generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs):
+ * generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd):
+ * generic/tcl.decls (generic table, positions 435+436):
+ * tests/info.test:
+ * doc/CrtMathFnc.3:
+ * doc/info.n: Changes due to TIP #15 "Functions to List and Detail
+ Math Functions"
+
2001-05-23 Jeff Hobbs <[email protected]>
* tests/io.test: changed io-52.[9-11] to not be platform sensitive
Index: doc/CrtMathFnc.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtMathFnc.3,v
retrieving revision 1.4
diff -u -r1.4 CrtMathFnc.3
--- doc/CrtMathFnc.3 2001/04/24 20:59:17 1.4
+++ doc/CrtMathFnc.3 2001/05/24 14:14:25
@@ -8,17 +8,26 @@
'\" RCS: @(#) $Id: CrtMathFnc.3,v 1.4 2001/04/24 20:59:17 kennykb Exp $
'\"
.so man.macros
-.TH Tcl_CreateMathFunc 3 7.0 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateMathFunc \- Define a new math function for expressions
+Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+void
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
+.sp
+.VS 8.4
+int
+\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, clientDataPtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
+.VE
.SH ARGUMENTS
-.AS Tcl_ValueType clientData
+.AS Tcl_ValueType *clientDataPtr
.AP Tcl_Interp *interp in
Interpreter in which new function will be defined.
.VS 8.4
@@ -34,6 +43,24 @@
Procedure that implements the function.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
+.AP int *numArgsPtr out
+Points to a variable that will be set to contain the number of
+arguments to the function.
+.AP Tcl_ValueType *argTypesPtr out
+Points to a variable that will be set to contain a pointer to an array
+giving the permissible types for each argument to the function which
+will need to be freed up using \fITcl_Free\fR.
+.AP Tcl_MathProc *procPtr out
+Points to a variable that will be set to contain a pointer to the
+implementation code for the function (or NULL if the function is
+implemented directly in bytecode.)
+.AP ClientData *clientDataPtr out
+Points to a variable that will be set to contain the clientData
+argument passed to \fITcl_CreateMathFunc\fR when the function was
+created if the function is not implemented directly in bytecode.
+.AP "CONST char" *pattern in
+Pattern to match against function names so as to filter them (by
+passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE
.SH DESCRIPTION
@@ -90,6 +117,32 @@
Under normal circumstances \fIproc\fR should return TCL_OK.
If an error occurs while executing the function, \fIproc\fR should
return TCL_ERROR and leave an error message in the interpreter's result.
+.PP
+.VS 8.4
+\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
+function \fIname\fR that were passed to a preceding
+\fBTcl_CreateMathFunc\fR call. Normally, the return code is
+\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
+is returned and an error message is placed in the interpreter's
+result.
+.PP
+If an error did not occur, the array reference placed in the variable
+pointed to by \fIargTypesPtr\fR is newly allocated, and should be
+released by passing it to \fBTcl_Free\fR. Some functions (the
+standard set implemented in the core) are implemented directly at the
+bytecode level; attempting to retrieve values for them causes a NULL
+to be stored in the variable pointed to by \fIprocPtr\fR and the
+variable pointed to by \fIclientDataPtr\fR will not be modified.
+.PP
+\fBTcl_ListMathFuncs\fR returns a Tcl object containing a list of all
+the math functions defined in the interpreter whose name matches
+\fIpattern\fR. In the case of an error, NULL is returned and an error
+message is left in the interpreter result, and otherwise the returned
+object will have a reference count of zero.
+.VE
.SH KEYWORDS
expression, mathematical function
+
+.SH "SEE ALSO"
+expr(n), info(n), Tcl_Free(3), Tcl_NewListObj(3)
Index: doc/info.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/info.n,v
retrieving revision 1.6
diff -u -r1.6 info.n
--- doc/info.n 2001/03/13 15:10:32 1.6
+++ doc/info.n 2001/05/24 14:14:25
@@ -75,7 +75,16 @@
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
+.VS 8.4
.TP
+\fBinfo functions \fR?\fIpattern\fR?
+If \fIpattern\fR isn't specified, returns a list of all the math
+functions currently defined.
+If \fIpattern\fR is specified, only those functions whose name matches
+\fIpattern\fR are returned. Matching is determined using the same
+rules as for \fBstring match\fR.
+.VE
+.TP
\fBinfo globals \fR?\fIpattern\fR?
If \fIpattern\fR isn't specified, returns a list of all the names
of currently-defined global variables.
@@ -200,4 +209,4 @@
'\" Local Variables:
'\" mode: nroff
-'\" End:
\ No newline at end of file
+'\" End:
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.47
diff -u -r1.47 tcl.decls
--- generic/tcl.decls 2001/05/15 21:30:46 1.47
+++ generic/tcl.decls 2001/05/24 14:14:26
@@ -1519,6 +1519,14 @@
declare 434 generic {
Tcl_UniChar * Tcl_GetUnicodeFromObj (Tcl_Obj *objPtr, int *lengthPtr)
}
+declare 435 generic {
+ int Tcl_GetMathFuncInfo(Tcl_Interp *interp, CONST char *name,
+ int *numArgsPtr, Tcl_ValueType **argTypesPtr,
+ Tcl_MathProc **procPtr, ClientData *clientDataPtr)
+}
+declare 436 generic {
+ Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, CONST char *pattern)
+}
##############################################################################
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.32
diff -u -r1.32 tclBasic.c
--- generic/tclBasic.c 2001/05/17 02:13:02 1.32
+++ generic/tclBasic.c 2001/05/24 14:14:26
@@ -2606,6 +2606,120 @@
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetMathFuncInfo --
+ *
+ * Discovers how a particular math function was created in a given
+ * interpreter.
+ *
+ * Results:
+ * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message
+ * in the interpreter result if that happens.)
+ *
+ * Side effects:
+ * If this function succeeds, the variables pointed to by the
+ * numArgsPtr and argTypePtr arguments will be updated to detail the
+ * arguments allowed by the function. The variable pointed to by the
+ * procPtr argument will be set to NULL if the function is a builtin
+ * function, and will be set to the address of the C function used to
+ * implement the math function otherwise (in which case the variable
+ * pointed to by the clientDataPtr argument will also be updated.)
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
+ clientDataPtr)
+ Tcl_Interp *interp;
+ CONST char *name;
+ int *numArgsPtr;
+ Tcl_ValueType **argTypesPtr;
+ Tcl_MathProc **procPtr;
+ ClientData *clientDataPtr;
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ MathFunc *mathFuncPtr;
+ Tcl_ValueType *argTypes;
+ int i,numArgs;
+
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, name);
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "math function \"", name, "\" not known in this interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+ *numArgsPtr = numArgs = mathFuncPtr->numArgs;
+ if (numArgs == 0) {
+ /* Avoid doing zero-sized allocs... */
+ numArgs = 1;
+ }
+ *argTypesPtr = argTypes =
+ (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
+ for (i = 0; i < mathFuncPtr->numArgs; i++) {
+ argTypes[i] = mathFuncPtr->argTypes[i];
+ }
+
+ if (mathFuncPtr->builtinFuncIndex == -1) {
+ *procPtr = (Tcl_MathProc *) NULL;
+ } else {
+ *procPtr = mathFuncPtr->proc;
+ *clientDataPtr = mathFuncPtr->clientData;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListMathFuncs --
+ *
+ * Produces a list of all the math functions defined in a given
+ * interpreter.
+ *
+ * Results:
+ * A pointer to a Tcl_Obj structure with a reference count of zero,
+ * or NULL in the case of an error (in which case a suitable error
+ * message will be left in the interpreter result.)
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ListMathFuncs(interp, pattern)
+ Tcl_Interp *interp;
+ CONST char *pattern;
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *resultList = Tcl_NewObj();
+ register Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ CONST char *name;
+
+ for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &hSearch);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ name = Tcl_GetHashKey(&iPtr->mathFuncTable, hPtr);
+ if ((pattern == NULL || Tcl_StringMatch(name, pattern)) &&
+ /* I don't expect this to fail, but... */
+ Tcl_ListObjAppendElement(interp, resultList,
+ Tcl_NewStringObj(name,-1)) != TCL_OK) {
+ Tcl_DecrRefCount(resultList);
+ return NULL;
+ }
+ }
+ return resultList;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_EvalObjEx --
*
* Execute Tcl commands stored in a Tcl object. These commands are
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.30
diff -u -r1.30 tclCmdIL.c
--- generic/tclCmdIL.c 2001/04/27 22:11:51 1.30
+++ generic/tclCmdIL.c 2001/05/24 14:14:27
@@ -102,6 +102,9 @@
static int InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -365,14 +368,14 @@
{
static char *subCmds[] = {
"args", "body", "cmdcount", "commands",
- "complete", "default", "exists", "globals",
+ "complete", "default", "exists", "functions", "globals",
"hostname", "level", "library", "loaded",
"locals", "nameofexecutable", "patchlevel", "procs",
"script", "sharedlibextension", "tclversion", "vars",
(char *) NULL};
enum ISubCmdIdx {
IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
- ICompleteIdx, IDefaultIdx, IExistsIdx, IGlobalsIdx,
+ ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
@@ -412,6 +415,9 @@
case IExistsIdx:
result = InfoExistsCmd(clientData, interp, objc, objv);
break;
+ case IFunctionsIdx:
+ result = InfoFunctionsCmd(clientData, interp, objc, objv);
+ break;
case IGlobalsIdx:
result = InfoGlobalsCmd(clientData, interp, objc, objv);
break;
@@ -922,6 +928,54 @@
} else {
Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
}
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoFunctionsCmd --
+ *
+ * Called to implement the "info functions" command that returns the
+ * list of math functions matching an optional pattern. Handles the
+ * following syntax:
+ *
+ * info functions ?pattern?
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If there is
+ * an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoFunctionsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ char *pattern;
+ Tcl_Obj *listPtr;
+
+ if (objc == 2) {
+ pattern = NULL;
+ } else if (objc == 3) {
+ pattern = Tcl_GetString(objv[2]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ listPtr = Tcl_ListMathFuncs(interp, pattern);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.49
diff -u -r1.49 tclDecls.h
--- generic/tclDecls.h 2001/05/15 21:30:46 1.49
+++ generic/tclDecls.h 2001/05/24 14:14:28
@@ -1366,6 +1366,15 @@
/* 434 */
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj * objPtr,
int * lengthPtr));
+/* 435 */
+EXTERN int Tcl_GetMathFuncInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, int * numArgsPtr,
+ Tcl_ValueType ** argTypesPtr,
+ Tcl_MathProc ** procPtr,
+ ClientData * clientDataPtr));
+/* 436 */
+EXTERN Tcl_Obj * Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * pattern));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -1868,6 +1877,8 @@
int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 434 */
+ int (*tcl_GetMathFuncInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)); /* 435 */
+ Tcl_Obj * (*tcl_ListMathFuncs) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 436 */
} TclStubs;
#ifdef __cplusplus
@@ -3655,6 +3666,14 @@
#ifndef Tcl_GetUnicodeFromObj
#define Tcl_GetUnicodeFromObj \
(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
+#endif
+#ifndef Tcl_GetMathFuncInfo
+#define Tcl_GetMathFuncInfo \
+ (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
+#endif
+#ifndef Tcl_ListMathFuncs
+#define Tcl_ListMathFuncs \
+ (tclStubsPtr->tcl_ListMathFuncs) /* 436 */
#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.49
diff -u -r1.49 tclStubInit.c
--- generic/tclStubInit.c 2001/05/15 21:30:46 1.49
+++ generic/tclStubInit.c 2001/05/24 14:14:28
@@ -838,6 +838,8 @@
Tcl_AttemptSetObjLength, /* 432 */
Tcl_GetChannelThread, /* 433 */
Tcl_GetUnicodeFromObj, /* 434 */
+ Tcl_GetMathFuncInfo, /* 435 */
+ Tcl_ListMathFuncs, /* 436 */
};
/* !END!: Do not edit above this line. */
Index: tests/info.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/info.test,v
retrieving revision 1.16
diff -u -r1.16 info.test
--- tests/info.test 2000/05/27 23:58:01 1.16
+++ tests/info.test 2001/05/24 14:14:28
@@ -591,21 +591,39 @@
t1
} {a}
-test info-20.1 {miscellaneous error conditions} {
+# Check whether the extra testing functions are defined...
+if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+ set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh}
+} else {
+ set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh}
+}
+test info-20.1 {info functions option} {info functions sin} sin
+test info-20.2 {info functions option} {lsort [info functions]} $functions
+test info-20.3 {info functions option} {
+ lsort [info functions a*]
+} {abs acos asin atan atan2}
+test info-20.4 {info functions option} {
+ lsort [info functions *tan*]
+} {atan atan2 tan tanh}
+test info-20.5 {info functions option} {
+ list [catch {info functions raise an error} msg] $msg
+} {1 {wrong # args: should be "info functions ?pattern?"}}
+
+test info-21.1 {miscellaneous error conditions} {
list [catch {info} msg] $msg
} {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-20.2 {miscellaneous error conditions} {
+test info-21.2 {miscellaneous error conditions} {
list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.3 {miscellaneous error conditions} {
+} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.3 {miscellaneous error conditions} {
list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.4 {miscellaneous error conditions} {
+} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.4 {miscellaneous error conditions} {
list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.5 {miscellaneous error conditions} {
+} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.5 {miscellaneous error conditions} {
list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
