diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index d58478d..72ed211 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -251,6 +251,7 @@ static Tcl_ObjCmdProc TestlinkarrayCmd; static Tcl_ObjCmdProc TestlistrepCmd; static Tcl_ObjCmdProc TestlocaleCmd; static Tcl_ObjCmdProc TestmainthreadCmd; +static Tcl_ObjCmdProc TestmsbObjCmd; static Tcl_ObjCmdProc TestsetmainloopCmd; static Tcl_ObjCmdProc TestexitmainloopCmd; static Tcl_ObjCmdProc TestpanicCmd; @@ -647,6 +648,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testlistrep", TestlistrepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testmsb", TestmsbObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserCmd, @@ -4003,6 +4005,48 @@ CleanupTestSetassocdataTests( /* *---------------------------------------------------------------------- * + * TestmsbObjCmd -- + * + * This procedure implements the "testmsb" command. It is + * used for testing the TclMSB() routine. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestmsbObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + Tcl_WideInt w = 0; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "integer"); + return TCL_ERROR; + } + if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &w)) { + return TCL_ERROR; + } + if (w <= 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("argument must be positive",-1)); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(TclMSB((unsigned long long)w))); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestparserCmd -- * * This procedure implements the "testparser" command. It is |