From 1ded7d18ee9da0c3312afb777ea2036a69265d36 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 29 Jan 2009 22:14:56 +0000 Subject: Fix [Bug 2006888] --- ChangeLog | 4 +++ tests/stringObj.test | 91 ++++++++++++++++++++++++++-------------------------- 2 files changed, 49 insertions(+), 46 deletions(-) diff --git a/ChangeLog b/ChangeLog index e9172a8..8f00e07 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2009-01-29 Donal K. Fellows + * tests/stringObj.test: [Bug 2006888]: Remove non-ASCII chars from + non-comment locations in the file, making it work more reliably in + locales with a non-Latin-1 default encoding. + * generic/tclNamesp.c (Tcl_FindCommand): [Bug 2519474]: Ensure that the path is not searched when the TCL_NAMESPACE_ONLY flag is given. diff --git a/tests/stringObj.test b/tests/stringObj.test index c215abe..8b38542 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -1,18 +1,18 @@ # Commands covered: none # -# This file contains tests for the procedures in tclStringObj.c -# that implement the Tcl type manager for the string type. +# This file contains tests for the procedures in tclStringObj.c that implement +# the Tcl type manager for the string type. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.17 2009/01/06 17:20:52 dgp Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.18 2009/01/29 22:14:56 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -21,7 +21,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint testobj [llength [info commands testobj]] testConstraint testdstring [llength [info commands testdstring]] - + test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] @@ -40,7 +40,7 @@ test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] - lappend result [teststringobj set 1 xyz] ;# makes existing obj a string + lappend result [teststringobj set 1 xyz] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} xyz string 2} @@ -48,7 +48,7 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 512] - lappend result [teststringobj set 1 foo] ;# makes existing obj a string + lappend result [teststringobj set 1 foo] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 512 foo string 2} @@ -198,19 +198,19 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj { [teststringobj ualloc 2] [teststringobj get 2] } {5 10 0 abcde 5 5 0 abcde} test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi string length $x set y $x - list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string string abcï¿®ghi®¿ï abcï¿®ghi string string} +} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi set y $x string length $x - list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string string abcï¿®ghi®¿ï abcï¿®ghi string string} +} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj { set x abcdefghi string length $x @@ -227,31 +227,31 @@ test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj { } {string string abcdefghijkl abcdefghi string string} test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi testdstring free - testdstring append ®¿ï -1 + testdstring append \u00ae\u00bf\u00ef -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcï¿®ghi®¿ï ®¿ï string none} +} "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi string length $x list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] -} {string abcï¿®ghiabcï¿®ghi string\ -abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\ -string} +} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\ +abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\ +string" test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} { set x abcdefghi testdstring free - testdstring append ®¿ï -1 + testdstring append \u00ae\u00bf\u00ef -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcdefghi®¿ï ®¿ï string none} +} "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} { set x abcdefghi testdstring free @@ -269,14 +269,14 @@ test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj { } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\ string} test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi testdstring free testdstring append jkl -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcï¿®ghijkl jkl string none} +} "string none abc\u00ef\u00bf\u00aeghijkl jkl string none" test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj { set x [expr {4 * 5}] set y [expr {4 + 5}] @@ -297,20 +297,19 @@ test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj { [set y] [testobj objtype $x] [testobj objtype $y] } {string int abcdefghi9 9 string int} test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi set y [expr {4 + 5}] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string int abcï¿®ghi9 9 string int} +} "string int abc\u00ef\u00bf\u00aeghi9 9 string int" test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj { # bug 2678, in <=8.2.0, the second obj (the one to append) in - # Tcl_AppendObjToObj was not correctly checked to see if it was - # all one byte chars, so a unicode string would be added as one - # byte chars. + # Tcl_AppendObjToObj was not correctly checked to see if it was all one + # byte chars, so a unicode string would be added as one byte chars. set x abcdef set len [string length $x] - set y aübåcï + set y a\u00fcb\u00e5c\u00ef set len [string length $y] append x $y string length $x @@ -319,7 +318,7 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} tes lappend q [string index $x $i] } set q -} {a b c d e f a ü b å c ï} +} "a b c d e f a \u00fc b \u00e5 c \u00ef" test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} { testdstring free @@ -330,12 +329,12 @@ test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring } [list none bcde string string] test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} { # Because this test does not use \uXXXX notation below instead of - # hardcoding the values, it may fail in multibyte locales. However, - # we need to test that the parser produces untyped objects even when there - # are high-ASCII characters in the input (like "ï"). I don't know what + # hardcoding the values, it may fail in multibyte locales. However, we + # need to test that the parser produces untyped objects even when there + # are high-ASCII characters in the input (like "ï"). I don't know what # else to do but inline those characters here. testdstring free - testdstring append "abcïïdef" -1 + testdstring append "abc\u00ef\u00efdef" -1 set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] @@ -385,15 +384,15 @@ test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj { list [string index $x end] [string index $x end-1] } {i h} test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj { - string index "ïa¿b®c®¿dï" 0 -} "ï" + string index "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0 +} "\u00ef" test stringObj-12.5 {Tcl_GetUniChar} testobj { - set x "ïa¿b®c®¿dï" + set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" list [string index $x 4] [string index $x 0] -} {® ï} +} "\u00ae \u00ef" test stringObj-12.6 {Tcl_GetUniChar} testobj { - string index "ïa¿b®cï¿d®" end -} "®" + string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end +} "\u00ae" test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj { set a "" @@ -407,7 +406,7 @@ test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj { list [string length $a] [string length $a] } {6 6} test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj { - string length "®" + string length "\u00ae" } 1 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { # string length "￮￮" @@ -440,7 +439,7 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj append 1 bar -1 teststringobj get 1 } {bar} - + if {[testConstraint testobj]} { testobj freeallvars } -- cgit v0.12