diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-02-05 15:26:42 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-02-05 15:26:42 (GMT) |
| commit | 21b70feb08dfc39254ed2217b397f61f1682a21a (patch) | |
| tree | 8d154be86727800ef84bc2008bf24a4936c8b723 /generic/tclTest.c | |
| parent | ee4107080cb9df21f2c3261f45a43f2e01f5564b (diff) | |
| download | tcl-21b70feb08dfc39254ed2217b397f61f1682a21a.zip tcl-21b70feb08dfc39254ed2217b397f61f1682a21a.tar.gz tcl-21b70feb08dfc39254ed2217b397f61f1682a21a.tar.bz2 | |
Fix [2089279]: StringObj.3 Tcl_ObjPrintf inaccuracies.
Not only the documentation, also the behavior in the "unsigned long" case was wrong. Testcases added.
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index ea23d40..3d46d8b 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -260,6 +260,7 @@ static Tcl_ObjCmdProc TestparseargsCmd; static Tcl_ObjCmdProc TestparserObjCmd; static Tcl_ObjCmdProc TestparsevarObjCmd; static Tcl_ObjCmdProc TestparsevarnameObjCmd; +static Tcl_ObjCmdProc TestprintObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, @@ -557,6 +558,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, + NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, @@ -3955,6 +3958,44 @@ TestparsevarnameObjCmd( /* *---------------------------------------------------------------------- * + * TestprintObjCmd -- + * + * This procedure implements the "testprint" command. It is + * used for being able to test the Tcl_ObjPrintf() function. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestprintObjCmd( + void *clientData, + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + Tcl_WideInt argv1 = 0; + long argv2; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "format longint"); + return TCL_OK; + } + + Tcl_GetWideIntFromObj(interp, objv[2], &argv1); + argv2 = (long)argv1; + Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv2, argv2, argv2, argv2)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestregexpObjCmd -- * * This procedure implements the "testregexp" command. It is used to give |