diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-01-18 09:31:01 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-01-18 09:31:01 (GMT) |
commit | 8f2192e73834a1ba84a6ea73b4970f9ad2dc102b (patch) | |
tree | 2a472cfe9212aa0161c76357d67a26bbe7fa2665 /tests | |
parent | ec01978b680c906c36b4e1802ae95b8874780034 (diff) | |
download | tcl-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.test | 17 |
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} |