Fix [0d78177f20]: unsigned use of Tcl_ObjPrintf() doesn't work as expected. With testcases.

3 files changed, 41 insertions, 9 deletions

diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index bc2d4e9..3ce22f0 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2079,7 +2079,7 @@ AppendUtfToUtfRep(
 /*
  *----------------------------------------------------------------------
  *
- * TclAppendUtfToUtf -- 
+ * TclAppendUtfToUtf --
  *
  *	This function appends "numBytes" bytes of "bytes" to the UTF string
  *	rep of "objPtr" (objPtr's internal rep converted to string on demand).
@@ -3017,6 +3017,28 @@ Tcl_Format(
  *---------------------------------------------------------------------------
  */
 
+static Tcl_Obj *
+NewIntObj(
+    char c,
+    Tcl_WideUInt max,
+	Tcl_WideInt value)
+{
+    if (!((max+1) & (Tcl_WideUInt)value)) {
+	/* sign-bit is not set, so handle the positive value */
+	return Tcl_NewWideIntObj(value & (Tcl_WideInt)max);
+    }
+
+    if (strchr("puoxX", c) && (max == WIDE_MAX)) {
+	/* Value > WIDE_MAX, so we need to use bignum */
+	mp_int bignumValue;
+	if (mp_init_u64(&bignumValue, (uint64_t)value) != MP_OKAY) {
+	    Tcl_Panic("%s: memory overflow", "AppendPrintfToObjVA");
+	}
+	return Tcl_NewBignumObj(&bignumValue);
+    }
+    return Tcl_NewWideIntObj(value | ~(Tcl_WideInt)max);
+}
+
 static void
 AppendPrintfToObjVA(
     Tcl_Obj *objPtr,
@@ -3100,15 +3122,15 @@ AppendPrintfToObjVA(
 		switch (size) {
 		case -1:
 		case 0:
-		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+		    Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, INT_MAX,
 			    va_arg(argList, int)));
 		    break;
 		case 1:
-		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+		    Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, LONG_MAX,
 			    va_arg(argList, long)));
 		    break;
 		case 2:
-		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+		    Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, WIDE_MAX,
 			    va_arg(argList, Tcl_WideInt)));
 		    break;
 		case 3:
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 08b3306..e656985 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -4396,16 +4396,17 @@ TestprintObjCmd(
 {
     Tcl_WideInt argv1 = 0;
     size_t argv2;
+    long argv3;
 
-    if (objc < 2 || objc > 3) {
+    if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
+	return TCL_OK;
     }
 
-    if (objc > 1) {
-	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
-    }
+    Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
     argv2 = (size_t)argv1;
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
+    argv3 = (long)argv1;
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv3, argv3));
     return TCL_OK;
 }
 
diff --git a/tests/util.test b/tests/util.test
index c3b9f2d..b643b13 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -23,6 +23,7 @@ testConstraint testdoubledigits [llength [info commands testdoubledigits]]
 testConstraint testprint [llength [info commands testprint]]
 
 testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}]
+testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
 
 
 # Big test for correct ordering of data in [expr]
@@ -4178,6 +4179,14 @@ test util-18.12 {Tcl_ObjPrintf} {testprint} {
     testprint "%I64d %Id" 65537
 } {65537 65537}
 
+test util-18.13 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body {
+    testprint "%llu %ju %lu" -1
+} -result {18446744073709551615 18446744073709551615 18446744073709551615}
+
+test util-18.14 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body {
+    testprint "%llu %zu %lu" -1
+} -result {18446744073709551615 18446744073709551615 18446744073709551615}
+
 if {[catch {set ::tcl_precision $saved_precision}]} {
     unset ::tcl_precision
 }