diff options
author | dgp <dgp@users.sourceforge.net> | 2019-03-07 20:02:09 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2019-03-07 20:02:09 (GMT) |
commit | 781c32ac29d9ab9c771d3dee2ed305450e9d8378 (patch) | |
tree | 909aa53fae9ed154f0e02e87322d02caa0786c66 /generic/tclTestProcBodyObj.c | |
parent | f2f7b85f8842e6ba235d539e1d3d53a2a83f549e (diff) | |
download | tcl-781c32ac29d9ab9c771d3dee2ed305450e9d8378.zip tcl-781c32ac29d9ab9c771d3dee2ed305450e9d8378.tar.gz tcl-781c32ac29d9ab9c771d3dee2ed305450e9d8378.tar.bz2 |
[39fed4dae5] Proposed test
Diffstat (limited to 'generic/tclTestProcBodyObj.c')
-rw-r--r-- | generic/tclTestProcBodyObj.c | 47 |
1 files changed, 46 insertions, 1 deletions
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 4d32c5a..fba2844 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -21,13 +21,14 @@ */ static const char packageName[] = "procbodytest"; -static const char packageVersion[] = "1.0"; +static const char packageVersion[] = "1.1"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; +static const char checkCommand[] = "check"; /* * this struct describes an entry in the table of command names and command @@ -46,6 +47,8 @@ typedef struct CmdTable { static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ProcBodyTestCheckObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, const char *namespace, const CmdTable *cmdTablePtr); @@ -57,11 +60,13 @@ static int RegisterCommand(Tcl_Interp* interp, static const CmdTable commands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, + { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; static const CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, + { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; @@ -301,6 +306,46 @@ ProcBodyTestProcObjCmd( } /* + *---------------------------------------------------------------------- + * + * ProcBodyTestCheckObjCmd -- + * + * Implements the "procbodytest::check" command. Here is the command + * description: + * procbodytest::check + * + * Performs an internal check that the Tcl_PkgPresent() command returns + * the same version number as was registered when the procbodytest package + * was provided. Places a boolean in the interp result indicating the + * test outcome. + * + * Results: + * Returns a standard Tcl code. + * + *---------------------------------------------------------------------- + */ + +static int +ProcBodyTestCheckObjCmd( + ClientData dummy, /* context; not used */ + Tcl_Interp *interp, /* the current interpreter */ + int objc, /* argument count */ + Tcl_Obj *const objv[]) /* arguments */ +{ + const char *version; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + strcmp(version, packageVersion) == 0)); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |