From 6def8b0f5838db2823d34a3210e018e1a59faee7 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 9 Oct 2022 18:11:44 +0000 Subject: TIP 643 code. Docs, tests pending --- generic/tcl.decls | 5 +++++ generic/tclDecls.h | 5 +++++ generic/tclEncoding.c | 27 +++++++++++++++++++++++++++ generic/tclStubInit.c | 1 + generic/tclTest.c | 24 ++++++++++++++++++++++-- 5 files changed, 60 insertions(+), 2 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 95cecdf..cbafa6d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2541,6 +2541,11 @@ declare 682 { # ----- BASELINE -- FOR -- 8.7.0 ----- # +# TIP 643 +declare 683 { + int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 80131e8..849a596 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2013,6 +2013,8 @@ EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); +/* 683 */ +EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2731,6 +2733,7 @@ typedef struct TclStubs { void (*reserved680)(void); void (*reserved681)(void); int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ + int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4125,6 +4128,8 @@ extern const TclStubs *tclStubsPtr; /* Slot 681 is reserved */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ +#define Tcl_GetEncodingNulLength \ + (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 52b02fc..efe4b43 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -983,6 +983,33 @@ Tcl_GetEncodingNames( } /* + *------------------------------------------------------------------------- + * + * Tcl_GetEncodingNulLength -- + * + * Given an encoding, return the number of nul bytes used for the + * string termination. + * + * Results: + * The name of the encoding. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ +int +Tcl_GetEncodingNulLength( + Tcl_Encoding encoding) +{ + if (encoding == NULL) { + encoding = systemEncoding; + } + + return ((Encoding *) encoding)->nullSize; +} + +/* *------------------------------------------------------------------------ * * Tcl_SetSystemEncoding -- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c7f178f..17254b8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2048,6 +2048,7 @@ const TclStubs tclStubs = { 0, /* 680 */ 0, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ + Tcl_GetEncodingNulLength, /* 683 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 95f4d2f..ae765aa 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1996,12 +1996,17 @@ TestencodingObjCmd( const char *string; TclEncoding *encodingPtr; static const char *const optionStrings[] = { - "create", "delete", NULL + "create", "delete", "nullength", NULL }; enum options { - ENC_CREATE, ENC_DELETE + ENC_CREATE, ENC_DELETE, ENC_NULLENGTH }; + if (objc < 2) { + Tcl_WrongNumArgs(interp, 2, objv, "?encoding?"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; @@ -2012,6 +2017,7 @@ TestencodingObjCmd( Tcl_EncodingType type; if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd"); return TCL_ERROR; } encodingPtr = (TclEncoding*)ckalloc(sizeof(TclEncoding)); @@ -2048,6 +2054,20 @@ TestencodingObjCmd( Tcl_FreeEncoding(encoding); /* Free to match CREATE */ TclFreeInternalRep(objv[2]); /* Free the cached ref */ break; + + case ENC_NULLENGTH: + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?encoding?"); + return TCL_ERROR; + } + encoding = + Tcl_GetEncoding(interp, objc == 2 ? NULL : Tcl_GetString(objv[2])); + if (encoding == NULL) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, + Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); + Tcl_FreeEncoding(encoding); } return TCL_OK; } -- cgit v0.12 From 23900950d5ad3b15b790aacb18f9e0220836b132 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 10 Oct 2022 13:52:29 +0000 Subject: Tests and docs for Tcl_GetEncodingNulLength --- doc/Encoding.3 | 6 ++++++ generic/tclTest.c | 2 +- tests/encoding.test | 11 +++++++++++ 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 86c5a78..c183b73 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -52,6 +52,9 @@ const char * \fBTcl_GetEncodingName\fR(\fIencoding\fR) .sp int +\fBTcl_GetEncodingNulLength\fR(\fIencoding\fR) +.sp +int \fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR) .sp const char * @@ -292,6 +295,9 @@ was used to create the encoding. The string returned by \fBTcl_GetEncodingName\fR is only guaranteed to persist until the \fIencoding\fR is deleted. The caller must not modify this string. .PP +\fBTcl_GetEncodingNulLength\fR returns the length of the terminating +nul byte sequence for strings in the specified encoding. +.PP \fBTcl_SetSystemEncoding\fR sets the default encoding that should be used whenever the user passes a NULL value for the \fIencoding\fR argument to any of the other encoding functions. If \fIname\fR is NULL, the system diff --git a/generic/tclTest.c b/generic/tclTest.c index ae765aa..2764ced 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2003,7 +2003,7 @@ TestencodingObjCmd( }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 2, objv, "?encoding?"); + Tcl_WrongNumArgs(interp, 1, objv, "command ?args?"); return TCL_ERROR; } diff --git a/tests/encoding.test b/tests/encoding.test index c8f409e..8e529af 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -841,6 +841,17 @@ runtests } +test encoding-29.0 {get encoding nul terminator lengths} -constraints { + testencoding +} -body { + list \ + [testencoding nullength ascii] \ + [testencoding nullength utf-16] \ + [testencoding nullength utf-32] \ + [testencoding nullength gb12345] \ + [testencoding nullength ksc5601] +} -result {1 2 4 2 2} + # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests -- cgit v0.12