From 95158a2d57b3724c868c22025657b56c2812f4d5 Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Mon, 13 Mar 2023 16:32:55 +0000
Subject: Fix passing of encoding state in testencoding Tcl_UtfToExternal

---
 generic/tclTest.c | 30 ++++++++++++++++--------------
 tests/utfext.test |  5 +++++
 2 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index eab3eab..6860e53 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2031,19 +2031,19 @@ static void SpecialFree(
  *    TCL_OK or TCL_ERROR. This any errors running the test, NOT the
  *    result of Tcl_UtfToExternal or Tcl_ExternalToUtf.
  *
- * Side effects: 
+ * Side effects:
  *
  *    The result in the interpreter is a list of the return code from the
  *    Tcl_UtfToExternal/Tcl_ExternalToUtf functions, the encoding state, and
  *    an encoded binary string of length dstLen. Note the string is the
  *    entire output buffer, not just the part containing the decoded
  *    portion. This allows for additional checks at test script level.
- * 
- *    If any of the srcreadvar, dstwrotevar and 
+ *
+ *    If any of the srcreadvar, dstwrotevar and
  *    dstcharsvar are specified and not empty, they are treated as names
  *    of variables where the *srcRead, *dstWrote and *dstChars output
  *    from the functions are stored.
- * 
+ *
  *    The function also checks internally whether nuls are correctly
  *    appended as requested but the TCL_ENCODING_NO_TERMINATE flag
  *    and that no buffer overflows occur.
@@ -2056,8 +2056,7 @@ static int UtfExtWrapper(
     Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[])
 {
     Tcl_Encoding encoding;
-    int encStateValue; /* Assumes Tcl_EncodingState points to integer!!! */
-    Tcl_EncodingState encState;
+    Tcl_EncodingState encState, *encStatePtr;
     Tcl_Size srcLen, bufLen;
     const unsigned char *bytes;
     unsigned char *bufPtr;
@@ -2121,13 +2120,16 @@ static int UtfExtWrapper(
     }
 
     /* Assumes state is integer if not "" */
-    if (Tcl_GetIntFromObj(interp, objv[5], &encStateValue) == TCL_OK) {
-        encState = (Tcl_EncodingState)&encStateValue;
+    Tcl_WideInt wide;
+    if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) {
+        encState = (Tcl_EncodingState) wide;
+        encStatePtr = &encState;
     } else if (Tcl_GetCharLength(objv[5]) == 0) {
-        encState = NULL;
+        encStatePtr = NULL;
     } else {
         return TCL_ERROR;
     }
+
     if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) {
         return TCL_ERROR;
     }
@@ -2162,7 +2164,7 @@ static int UtfExtWrapper(
 			 "TCL_ENCODING_CHAR_LIMIT set in flags.", TCL_STATIC);
 	    return TCL_ERROR;
 	}
-	if (Tcl_GetIntFromObj(interp, dstCharsVar, &dstChars) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, valueObj, &dstChars) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } else {
@@ -2170,12 +2172,12 @@ static int UtfExtWrapper(
     }
 
     bufLen = dstLen + 4; /* 4 -> overflow detection */
-    bufPtr = ckalloc(bufLen);
+    bufPtr = (unsigned char *) ckalloc(bufLen);
     memset(bufPtr, 0xFF, dstLen); /* Need to check nul terminator */
     memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4);   /* overflow detection */
     bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */
-    result = (*transformer)(interp, encoding, bytes, srcLen, flags,
-                               &encState, bufPtr, dstLen,
+    result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags,
+                            encStatePtr, (char *) bufPtr, dstLen,
                                srcReadVar ? &srcRead : NULL,
                                &dstWrote,
                                dstCharsVar ? &dstChars : NULL);
@@ -2210,7 +2212,7 @@ static int UtfExtWrapper(
         }
         result = TCL_OK;
         resultObjs[1] =
-            encState ? Tcl_NewIntObj(encStateValue) : Tcl_NewObj();
+            encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)encState) : Tcl_NewObj();
         resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen);
         if (srcReadVar) {
 	    if (Tcl_ObjSetVar2(interp,
diff --git a/tests/utfext.test b/tests/utfext.test
index 61e36b8..6cf3dd7 100644
--- a/tests/utfext.test
+++ b/tests/utfext.test
@@ -88,6 +88,11 @@ test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body {
     testencoding Tcl_UtfToExternal unicode A {start end} {} 1
 } -result {nospace {} {}}
 
+# Another bug - char limit not obeyed
+# % set cv 2
+# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv
+# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ
+
 ::tcltest::cleanupTests
 return
 
-- 
cgit v0.12