Index: ChangeLog =================================================================== RCS file: /cvsroot/tcl/tcl/ChangeLog,v retrieving revision 1.434 diff -u -r1.434 ChangeLog --- ChangeLog 2001/05/11 23:02:18 1.434 +++ ChangeLog 2001/05/13 11:11:49 @@ -1,3 +1,13 @@ +2001-05-12 Donal K. Fellows + + * generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs): + * generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd): + * generic/tcl.decls (generic table, positions 434+435): + * tests/info.test: + * doc/CrtMathFnc.3: + * doc/info.n: Changes due to TIP #15 "Functions to List and Detail + Math Functions" + 2001-05-11 Mo DeJong * unix/Makefile.in: Add a LDFLAGS variable to the 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/13 11:11:50 @@ -11,14 +11,23 @@ .TH Tcl_CreateMathFunc 3 7.0 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 \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 * +Tcl_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 Tcl_StringMatch), 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/13 11:11:52 @@ -75,6 +75,15 @@ 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 Index: generic/tcl.decls =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v retrieving revision 1.46 diff -u -r1.46 tcl.decls --- generic/tcl.decls 2001/04/24 20:59:17 1.46 +++ generic/tcl.decls 2001/05/13 11:11:57 @@ -1514,6 +1514,14 @@ declare 433 generic { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) } +declare 434 generic { + int Tcl_GetMathFuncInfo(Tcl_Interp *interp, char *name, int *numArgsPtr, + Tcl_ValueType **argTypesPtr, Tcl_MathProc *procPtr, + ClientData *clientDataPtr) +} +declare 435 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.31 diff -u -r1.31 tclBasic.c --- generic/tclBasic.c 2001/04/25 09:44:49 1.31 +++ generic/tclBasic.c 2001/05/13 11:12:15 @@ -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; + 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/13 11:12: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 = InfoFuncionsCmd(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: 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/13 11:12:31 @@ -591,21 +591,34 @@ t1 } {a} -test info-20.1 {miscellaneous error conditions} { +test info-20.1 {info functions option} { + info functions sin +} sin +test info-20.2 {info functions option} { + lsort [info functions a*] +} {abs acos asin atan atan2} +test info-20.3 {info functions option} { + lsort [info 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} +test info-20.4 {info functions option} { + list [catch {info functions a b} 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}