summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclStringObj.c33
-rw-r--r--tests/format.test21
2 files changed, 48 insertions, 6 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index b8b64d4..560c169 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1670,8 +1670,11 @@ Tcl_AppendFormatToObj(
while (*format != '\0') {
char *end;
- int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
- int width, gotPrecision, precision, useShort, useWide, useBig;
+ int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
+ int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+ int useWide = 0;
+#endif
int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_UniChar ch;
@@ -1747,7 +1750,6 @@ Tcl_AppendFormatToObj(
* Step 2. Set of flags.
*/
- gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
sawFlag = 1;
do {
switch (ch) {
@@ -1848,7 +1850,6 @@ Tcl_AppendFormatToObj(
* Step 5. Length modifier.
*/
- useShort = useWide = useBig = 0;
if (ch == 'h') {
useShort = 1;
format += step;
@@ -1869,7 +1870,9 @@ Tcl_AppendFormatToObj(
if ((format[1] == '6') && (format[2] == '4')) {
format += (step + 2);
step = Tcl_UtfToUniChar(format, &ch);
- useBig = 1;
+#ifndef TCL_WIDE_INT_IS_LONG
+ useWide = 1;
+#endif
} else if ((format[1] == '3') && (format[2] == '2')) {
format += (step + 2);
step = Tcl_UtfToUniChar(format, &ch);
@@ -1880,10 +1883,17 @@ Tcl_AppendFormatToObj(
} else if ((ch == 't') || (ch == 'z')) {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (sizeof(size_t) > sizeof(int)) {
+ useWide = 1;
+ }
+#endif
} else if ((ch == 'q') ||(ch == 'j')) {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
- useBig = 1;
+#ifndef TCL_WIDE_INT_IS_LONG
+ useWide = 1;
+#endif
}
format += step;
@@ -1947,11 +1957,17 @@ Tcl_AppendFormatToObj(
mp_int big;
int toAppend, isNegative = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (ch == 'p') {
+ useWide = 1;
+ }
+#endif
if (useBig) {
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
@@ -1966,6 +1982,7 @@ Tcl_AppendFormatToObj(
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt) 0);
+#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
@@ -2033,8 +2050,10 @@ Tcl_AppendFormatToObj(
if (useShort) {
pure = Tcl_NewIntObj((int) s);
+#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
+#endif
} else if (useBig) {
pure = Tcl_NewBignumObj(&big);
} else {
@@ -2118,6 +2137,7 @@ Tcl_AppendFormatToObj(
numDigits++;
us /= base;
}
+#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
@@ -2126,6 +2146,7 @@ Tcl_AppendFormatToObj(
numDigits++;
uw /= base;
}
+#endif
} else if (useBig && big.used) {
int leftover = (big.used * DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
diff --git a/tests/format.test b/tests/format.test
index 7186729..00b6939 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -21,6 +21,7 @@ testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
@@ -363,6 +364,26 @@ test format-8.23 {error conditions} {
catch {format "%d %d" 24 xyz} msg
set msg
} {expected integer but got "xyz"}
+# Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and
+# equivalent to "%d" in 32-bit platforms, they are really not useful in
+# scripts, therefore they are not documented. It's intended use is through
+# the function Tcl_AppendPrintfToObj (et al).
+test format-8.24 {Undocumented formats} -body {
+ format "%zd %td %d" [expr 2**30] [expr 2**30] [expr 2**30]
+} -result {1073741824 1073741824 1073741824}
+test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body {
+ format "%zd %td %lld" [expr 2**33] [expr 2**33] [expr 2**33]
+} -result {8589934592 8589934592 8589934592}
+# Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent
+# to "%#x" in 32-bit platforms, it are really not useful in scripts,
+# therefore they are not documented. It's intended use is through the
+# function Tcl_AppendPrintfToObj (et al).
+test format-8.26 {Undocumented formats} -body {
+ format "%p %#x" [expr 2**31] [expr 2**31]
+} -result {0x80000000 0x80000000}
+test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
+ format "%p %#llx" [expr 2**33] [expr 2**33]
+} -result {0x200000000 0x200000000}
test format-9.1 {long result} {
set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}