summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-01-18 09:31:01 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-01-18 09:31:01 (GMT)
commit8f2192e73834a1ba84a6ea73b4970f9ad2dc102b (patch)
tree2a472cfe9212aa0161c76357d67a26bbe7fa2665 /tests
parentec01978b680c906c36b4e1802ae95b8874780034 (diff)
downloadtcl-8f2192e73834a1ba84a6ea73b4970f9ad2dc102b.zip
tcl-8f2192e73834a1ba84a6ea73b4970f9ad2dc102b.tar.gz
tcl-8f2192e73834a1ba84a6ea73b4970f9ad2dc102b.tar.bz2
[Bug 2932421]: Make [format] less likely to smash intreps.
Diffstat (limited to 'tests')
-rw-r--r--tests/format.test17
1 files changed, 10 insertions, 7 deletions
diff --git a/tests/format.test b/tests/format.test
index 8aa7d0b..54d9ffb 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: format.test,v 1.29 2009/07/31 16:55:58 dgp Exp $
+# RCS: @(#) $Id: format.test,v 1.30 2010/01/18 09:31:02 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -23,7 +23,7 @@ testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
-
+
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
@@ -536,14 +536,11 @@ test format-18.1 {do not demote existing numeric values} {
# Ensure $a and $b are separate objects
set b 0xaaaa
append b aaaa
-
set result [expr {$a == $b}]
format %08lx $b
lappend result [expr {$a == $b}]
-
set b 0xaaaa
append b aaaa
-
lappend result [expr {$a == $b}]
format %08x $b
lappend result [expr {$a == $b}]
@@ -561,15 +558,21 @@ test format-19.1 {
set x 0x8fedc654
list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
-
test format-19.2 {Bug 1867855} {
format %llx 0
} 0
-
test format-19.3 {Bug 2830354} {
string length [format %340f 0]
} 340
+# Note that this test may fail in future versions
+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
+ tcl::unsupported::representation $x
+} -match glob -result {value is a dict with *, string representation "*".}
+
# cleanup
catch {unset a}
catch {unset b}