Supply more C99-compatible (and MSVC) format options: '%p' for pointers, 'z'/'j'/'I' for size_t/intptr_diff, 'j'/'q' for long long. Also add "I32" froom MSVC.

Remove TCL_LL_MODIFIER specified as "L" for Borland: This must be wrong as "L" is meant for long double. Just assume that later Borland compilers are MSVC-compatible.

4 files changed, 65 insertions, 16 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 1491745..bdb4035 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -393,11 +393,7 @@ typedef long LONG;
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
 #   if defined(_WIN32)
 #      define TCL_WIDE_INT_TYPE __int64
-#      ifdef __BORLANDC__
-#         define TCL_LL_MODIFIER	"L"
-#      else /* __BORLANDC__ */
-#         define TCL_LL_MODIFIER	"I64"
-#      endif /* __BORLANDC__ */
+#      define TCL_LL_MODIFIER	"I64"
 #   elif defined(__GNUC__)
 #      define TCL_WIDE_INT_TYPE long long
 #      define TCL_LL_MODIFIER	"ll"
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index c45baa1..b8b64d4 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1865,11 +1865,22 @@ Tcl_AppendFormatToObj(
 		useWide = 1;
 #endif
 	    }
-	} else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) {
-	    format += (step + 2);
+	} else if (ch == 'I') {
+	    if ((format[1] == '6') && (format[2] == '4')) {
+		format += (step + 2);
+		step = Tcl_UtfToUniChar(format, &ch);
+		useBig = 1;
+	    } else if ((format[1] == '3') && (format[2] == '2')) {
+		format += (step + 2);
+		step = Tcl_UtfToUniChar(format, &ch);
+	    } else {
+		format += step;
+		step = Tcl_UtfToUniChar(format, &ch);
+	    }
+	} else if ((ch == 't') || (ch == 'z')) {
+	    format += step;
 	    step = Tcl_UtfToUniChar(format, &ch);
-	    useBig = 1;
-	} else if (ch == 'L') {
+	} else if ((ch == 'q') ||(ch == 'j')) {
 	    format += step;
 	    step = Tcl_UtfToUniChar(format, &ch);
 	    useBig = 1;
@@ -1925,6 +1936,7 @@ Tcl_AppendFormatToObj(
 	    }
 	case 'd':
 	case 'o':
+	case 'p':
 	case 'x':
 	case 'X':
 	case 'b': {
@@ -1993,13 +2005,14 @@ Tcl_AppendFormatToObj(
 		segmentLimit -= 1;
 	    }
 
-	    if (gotHash) {
+	    if (gotHash || (ch == 'p')) {
 		switch (ch) {
 		case 'o':
 		    Tcl_AppendToObj(segment, "0", 1);
 		    segmentLimit -= 1;
 		    precision--;
 		    break;
+		case 'p':
 		case 'x':
 		case 'X':
 		    Tcl_AppendToObj(segment, "0x", 2);
@@ -2078,6 +2091,7 @@ Tcl_AppendFormatToObj(
 
 	    case 'u':
 	    case 'o':
+	    case 'p':
 	    case 'x':
 	    case 'X':
 	    case 'b': {
@@ -2467,6 +2481,7 @@ AppendPrintfToObjVA(
 	    case 'u':
 	    case 'd':
 	    case 'o':
+	    case 'p':
 	    case 'x':
 	    case 'X':
 		seekingConversion = 0;
@@ -2517,7 +2532,15 @@ AppendPrintfToObjVA(
 		++size;
 		p++;
 		break;
-	    case 'L':
+	    case 't':
+	    case 'z':
+		if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
+		    size = 2;
+		}
+		p++;
+		break;
+	    case 'j':
+	    case 'q':
 		size = 2;
 		p++;
 		break;
@@ -2525,6 +2548,10 @@ AppendPrintfToObjVA(
 		if (p[1]=='6' && p[2]=='4') {
 		    p += 2;
 		    size = 2;
+		} else if (p[1]=='3' && p[2]=='2') {
+		    p += 2;
+		} else if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
+		    size = 2;
 		}
 		p++;
 		break;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 84d4ea1..0f019bb 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -3847,6 +3847,7 @@ TestprintObjCmd(
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
     Tcl_WideInt argv1 = 0;
+    size_t argv2;
 
     if (objc < 2 || objc > 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
@@ -3855,7 +3856,8 @@ TestprintObjCmd(
     if (objc > 1) {
 	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
     }
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1));
+    argv2 = (size_t)argv1;
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
     return TCL_OK;
 }
 
diff --git a/tests/util.test b/tests/util.test
index 1a3eecb..22d120b 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -4027,21 +4027,45 @@ test util-18.2 {Tcl_ObjPrintf} {testprint} {
 } {9223372036854775807}
 
 test util-18.3 {Tcl_ObjPrintf} {testprint} {
-    testprint %Ld [expr 2**63-1]
+    testprint %qd [expr 2**63-1]
 } {9223372036854775807}
 
 test util-18.4 {Tcl_ObjPrintf} {testprint} {
+    testprint %jd [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.5 {Tcl_ObjPrintf} {testprint} {
     testprint %lld [expr -2**63]
 } {-9223372036854775808}
 
-test util-18.5 {Tcl_ObjPrintf} {testprint} {
+test util-18.6 {Tcl_ObjPrintf} {testprint} {
     testprint %I64d [expr -2**63]
 } {-9223372036854775808}
 
-test util-18.6 {Tcl_ObjPrintf} {testprint} {
-    testprint %Ld [expr -2**63]
+test util-18.7 {Tcl_ObjPrintf} {testprint} {
+    testprint %qd [expr -2**63]
 } {-9223372036854775808}
 
+test util-18.8 {Tcl_ObjPrintf} {testprint} {
+    testprint %jd [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.9 {Tcl_ObjPrintf} {testprint} {
+    testprint "%I64d %I32d" [expr -2**63+2]
+} {-9223372036854775806 2}
+
+test util-18.10 {Tcl_ObjPrintf} {testprint} {
+    testprint "%I64d %p" 65535
+} {65535 0xffff}
+
+test util-18.11 {Tcl_ObjPrintf} {testprint} {
+    testprint "%I64d %td" 65536
+} {65536 65536}
+
+test util-18.12 {Tcl_ObjPrintf} {testprint} {
+    testprint "%I64d %Id" 65537
+} {65537 65537}
+
 set ::tcl_precision $saved_precision
 
 # cleanup