merge trunkinitsubsystems

1 files changed, 34 insertions, 4 deletions

diff --git a/tests/format.test b/tests/format.test
index 27eac31..a4ea25e 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
@@ -349,9 +350,9 @@ test format-8.19 {error conditions} {
     catch {format %q x}
 } 1
 test format-8.20 {error conditions} {
-    catch {format %q x} msg
+    catch {format %r x} msg
     set msg
-} {bad field specifier "q"}
+} {bad field specifier "r"}
 test format-8.21 {error conditions} {
     catch {format %d}
 } 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}
@@ -528,6 +549,12 @@ test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
 test format-17.4 {testing %l with non-integer} {
     format %lf 1
 } 1.000000
+test format-17.5 {testing %llu with bignum} {
+    format %llu 0xabcdef0123456789abcdef
+} 207698809136909011942886895
+test format-17.6 {testing %llu with negative number} -body {
+    format %llu -1
+} -returnCodes 1 -result {unsigned bignum format is invalid}
 
 test format-18.1 {do not demote existing numeric values} {
     set a 0xaaaaaaaa
@@ -564,9 +591,12 @@ test format-19.3 {Bug 2830354} {
 test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
     set x [dict create a b c d]
     format %s $x
-    # After this, obj in $x should be a dict with a non-NULL bytes field
+    # After this, obj in $x should be a dict
+    # We are testing to make sure it has not been shimmered to a
+    # different intrep when that is not necessary.
+    # Whether or not there is a string rep - we should not care!
     tcl::unsupported::representation $x
-} -match glob -result {value is a dict with *, string representation "*"}
+} -match glob -result {value is a dict *}
 
 # cleanup
 catch {unset a}