From 82d0258052c45ac6767727539635540dc724182c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 14 Dec 2016 14:14:17 +0000
Subject: Implement all possible TCL_LL_MODIFIER formats in Tcl_ObjPrintf(),
 can be "ll", "I64" and "L", whatever the platform defines for long long
 integer. With test-cases.

---
 generic/tclStringObj.c | 11 ++++++++++-
 generic/tclTest.c      | 42 ++++++++++++++++++++++++++++++++++++++++++
 tests/util.test        | 25 +++++++++++++++++++++++++
 3 files changed, 77 insertions(+), 1 deletion(-)

diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 65f9ab1..2b1dfc5 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1866,7 +1866,12 @@ Tcl_AppendFormatToObj(
 #endif
 	    }
 	} else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) {
-	    step += 2;
+	    format += (step + 2);
+	    step = Tcl_UtfToUniChar(format, &ch);
+	    useBig = 1;
+	} else if (ch == 'L') {
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
 	    useBig = 1;
 	}
 
@@ -2512,6 +2517,10 @@ AppendPrintfToObjVA(
 		++size;
 		p++;
 		break;
+	    case 'L':
+		size = 2;
+		p++;
+		break;
 	    case 'I':
 		if (p[1]=='6' && p[2]=='4') {
 		    p += 2;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e30c4d0..dee1fe7 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -318,6 +318,9 @@ static int		TestparsevarnameObjCmd(ClientData dummy,
 static int		TestpreferstableObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		TestprintObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		TestregexpObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -649,6 +652,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -3820,6 +3825,43 @@ TestpreferstableObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestprintObjCmd --
+ *
+ *	This procedure implements the "testprint" command.  It is
+ *	used for being able to test the Tcl_ObjPrintf() function.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestprintObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
+{
+    Tcl_WideInt argv1 = 0;
+
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");   
+    }
+
+    if (objc > 1) {
+	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
+    }
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestregexpObjCmd --
  *
  *	This procedure implements the "testregexp" command. It is used to give
diff --git a/tests/util.test b/tests/util.test
index 2ac11bf..1a3eecb 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -20,6 +20,7 @@ testConstraint testbytestring [llength [info commands testbytestring]]
 testConstraint testdstring [llength [info commands testdstring]]
 testConstraint testconcatobj [llength [info commands testconcatobj]]
 testConstraint testdoubledigits [llength [info commands testdoubledigits]]
+testConstraint testprint [llength [info commands testprint]]
 
 # Big test for correct ordering of data in [expr]
 
@@ -4017,6 +4018,30 @@ test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
     0x4400000000000000 0xc400000000000000
 }]
 
+test util-18.1 {Tcl_ObjPrintf} {testprint} {
+    testprint %lld [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.2 {Tcl_ObjPrintf} {testprint} {
+    testprint %I64d [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.3 {Tcl_ObjPrintf} {testprint} {
+    testprint %Ld [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.4 {Tcl_ObjPrintf} {testprint} {
+    testprint %lld [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.5 {Tcl_ObjPrintf} {testprint} {
+    testprint %I64d [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.6 {Tcl_ObjPrintf} {testprint} {
+    testprint %Ld [expr -2**63]
+} {-9223372036854775808}
+
 set ::tcl_precision $saved_precision
 
 # cleanup
-- 
cgit v0.12