diff options
| author | apnadkarni <apnmbx-wits@yahoo.com> | 2022-07-12 12:31:57 (GMT) |
|---|---|---|
| committer | apnadkarni <apnmbx-wits@yahoo.com> | 2022-07-12 12:31:57 (GMT) |
| commit | 1e6f410bd20b8576dbd0be31a153d56d48a1dae4 (patch) | |
| tree | 4d1d271f0b2ebd658230ba2acb4eb32da025102a /generic/tclTest.c | |
| parent | a6ed76df7c2b1d8c8f3296a99023f88fc76c3f04 (diff) | |
| download | tcl-1e6f410bd20b8576dbd0be31a153d56d48a1dae4.zip tcl-1e6f410bd20b8576dbd0be31a153d56d48a1dae4.tar.gz tcl-1e6f410bd20b8576dbd0be31a153d56d48a1dae4.tar.bz2 | |
Fix [b79df322a9]. Tcl_GetUnicode/Tcl_NewUnicodeObj crash. Add tests
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 b2632f0..bf5741c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -222,6 +222,7 @@ static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; +static Tcl_ObjCmdProc Testutf16stringObjCmd; static Tcl_CmdProc TestcmdinfoCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; @@ -560,6 +561,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testutf16string", Testutf16stringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, @@ -5176,6 +5178,45 @@ TestbytestringObjCmd( /* *---------------------------------------------------------------------- * + * Testutf16stringObjCmd -- + * + * This specifically tests the Tcl_GetUnicode and Tcl_NewUnicodeObj + * C functions which broke in Tcl 8.7 and were undetected by the + * existing test suite. Bug [b79df322a9] + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +Testutf16stringObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n = 0; + const Tcl_UniChar *p; + (void)dummy; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "string"); + return TCL_ERROR; + } + + p = Tcl_GetUnicode(objv[1]); + Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(p, -1)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing |