From 8afc6eacf92cf29e37c07ccf08890f85b5dc1f5a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 17 Jun 2024 14:54:07 +0000
Subject: Implement %z/%t/%q/%j size modifiers for 'scan'. Part of TIP #697,
 which is suitable for 8.7 too.

---
 doc/scan.n        |  7 ++++---
 generic/tclScan.c | 36 ++++++++++++++++++++++++------------
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/doc/scan.n b/doc/scan.n
index c01a305..46bfb91 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -74,12 +74,13 @@ one of Tcl's integer values.  The size modifier field dictates the
 integer range acceptable to be stored in a variable, or, for the inline
 case, in a position in the result list.
 The syntactically valid values for the size modifier are \fBh\fR, \fBL\fR,
-\fBl\fR, and \fBll\fR.  The \fBh\fR size modifier value is equivalent
+\fBl\fR, \fBz\fR, \fBt\fR, and \fBll\fR.  The \fBh\fR size
+modifier value is equivalent
 to the absence of a size modifier in the the conversion specifier.
 Either one indicates the integer range to be stored is limited to the range
 determined by the value of the \fBwordSize\fR element of the \fBtcl_platform\fR
-array).  The \fBL\fR size modifier is equivalent to the \fBl\fR size
-modifier. Either one indicates the integer range to be stored is
+array).  The \fBL\fR, \fBq\fR or \fBj\fR size modifiers are equivalent to the
+\fBl\fR size modifier. Either of them indicates the integer range to be stored is
 limited to the same range produced by the \fBwide()\fR function of
 the \fBexpr\fR command.  The \fBll\fR size modifier indicates that
 the integer range to be stored is unlimited.
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 8969240..e852d63 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -319,7 +319,7 @@ ValidateFormat(
 	    if (ul == 0 || ul >= INT_MAX) {
 		goto badIndex;
 	    }
-	    objIndex = (int) ul - 1;
+	    objIndex = (int)ul - 1;
 	    if (numVars && (objIndex >= numVars)) {
 		goto badIndex;
 	    } else if (numVars == 0) {
@@ -361,6 +361,13 @@ ValidateFormat(
 	 */
 
 	switch (ch) {
+	case 'z':
+	case 't':
+	    if (sizeof(void *) > sizeof(int)) {
+		flags |= SCAN_LONGER;
+	    }
+	    format += TclUtfToUniChar(format, &ch);
+	    break;
 	case 'l':
 	    if (*format == 'l') {
 		flags |= SCAN_BIG;
@@ -370,6 +377,8 @@ ValidateFormat(
 	    }
 	    /* FALLTHRU */
 	case 'L':
+	case 'j':
+	case 'q':
 	    flags |= SCAN_LONGER;
 	    /* FALLTHRU */
 	case 'h':
@@ -567,7 +576,7 @@ ValidateFormat(
 
 int
 Tcl_ScanObjCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -578,7 +587,8 @@ Tcl_ScanObjCmd(
     long value;
     const char *string, *end, *baseString;
     char op = 0;
-    int width, underflow = 0;
+    int underflow = 0;
+    Tcl_Size width;
     Tcl_WideInt wideValue;
     Tcl_UniChar ch = 0, sch = 0;
     Tcl_Obj **objs = NULL, *objPtr = NULL;
@@ -677,7 +687,7 @@ Tcl_ScanObjCmd(
 	    if (*formatEnd == '$') {
 		format = formatEnd+1;
 		format += TclUtfToUniChar(format, &ch);
-		objIndex = (int) value - 1;
+		objIndex = (int)value - 1;
 	    }
 	}
 
@@ -686,7 +696,7 @@ Tcl_ScanObjCmd(
 	 */
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
+	    width = (int)strtoul(format-1, (char **)&format, 10);/* INTL: "C" locale. */
 	    format += TclUtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
@@ -899,7 +909,7 @@ Tcl_ScanObjCmd(
 		width = ~0;
 	    }
 	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
-		&end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
+		    &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
 		Tcl_DecrRefCount(objPtr);
 		if (width < 0) {
 		    if (*end == '\0') {
@@ -918,7 +928,7 @@ Tcl_ScanObjCmd(
 		break;
 	    }
 	    if (flags & SCAN_LONGER) {
-		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
+		if (TclGetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
 		    if (TclGetString(objPtr)[0] == '-') {
 			wideValue = WIDE_MIN;
 		    } else {
@@ -1070,22 +1080,24 @@ Tcl_ScanObjCmd(
     } else {
 	/*
 	 * Here no vars were specified, we want a list returned (inline scan)
+	 * We create an empty Tcl_Obj to fill missing values rather than
+	 * allocating a new Tcl_Obj every time.
 	 */
-
+	Tcl_Obj *emptyObj = NULL;
 	TclNewObj(objPtr);
 	for (i = 0; i < totalVars; i++) {
 	    if (objs[i] != NULL) {
 		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
 		Tcl_DecrRefCount(objs[i]);
 	    } else {
-		Tcl_Obj *obj;
 		/*
 		 * More %-specifiers than matching chars, so we just spit out
 		 * empty strings for these.
 		 */
-
-		TclNewObj(obj);
-		Tcl_ListObjAppendElement(NULL, objPtr, obj);
+		if (!emptyObj) {
+		    TclNewObj(emptyObj);
+		}
+		Tcl_ListObjAppendElement(NULL, objPtr, emptyObj);
 	    }
 	}
     }
-- 
cgit v0.12