diff options
Diffstat (limited to 't/lib/locale.t')
| -rwxr-xr-x | t/lib/locale.t | 195 |
1 files changed, 152 insertions, 43 deletions
diff --git a/t/lib/locale.t b/t/lib/locale.t index 83fa46bd73..7f8c858f1f 100755 --- a/t/lib/locale.t +++ b/t/lib/locale.t @@ -1,6 +1,6 @@ #!./perl -wT -print "1..67\n"; +print "1..104\n"; BEGIN { chdir 't' if -d 't'; @@ -74,15 +74,15 @@ check_taint 19, $+; check_taint 20, $1; check_taint_not 21, $2; -/(\W)/; # taint $&, $`, $', $+, $1. -check_taint 22, $&; -check_taint 23, $`; -check_taint 24, $'; -check_taint 25, $+; -check_taint 26, $1; +/(.)/; # untaint $&, $`, $', $+, $1. +check_taint_not 22, $&; +check_taint_not 23, $`; +check_taint_not 24, $'; +check_taint_not 25, $+; +check_taint_not 26, $1; check_taint_not 27, $2; -/(\s)/; # taint $&, $`, $', $+, $1. +/(\W)/; # taint $&, $`, $', $+, $1. check_taint 28, $&; check_taint 29, $`; check_taint 30, $'; @@ -90,7 +90,7 @@ check_taint 31, $+; check_taint 32, $1; check_taint_not 33, $2; -/(\S)/; # taint $&, $`, $', $+, $1. +/(\s)/; # taint $&, $`, $', $+, $1. check_taint 34, $&; check_taint 35, $`; check_taint 36, $'; @@ -98,45 +98,105 @@ check_taint 37, $+; check_taint 38, $1; check_taint_not 39, $2; +/(\S)/; # taint $&, $`, $', $+, $1. +check_taint 40, $&; +check_taint 41, $`; +check_taint 42, $'; +check_taint 43, $+; +check_taint 44, $1; +check_taint_not 45, $2; + $_ = $a; # untaint $_ -check_taint_not 40, $_; +check_taint_not 46, $_; /(b)/; # this must not taint -check_taint_not 41, $&; -check_taint_not 42, $`; -check_taint_not 43, $'; -check_taint_not 44, $+; -check_taint_not 45, $1; -check_taint_not 46, $2; +check_taint_not 47, $&; +check_taint_not 48, $`; +check_taint_not 49, $'; +check_taint_not 50, $+; +check_taint_not 51, $1; +check_taint_not 52, $2; $_ = $a; # untaint $_ -check_taint_not 47, $_; +check_taint_not 53, $_; $b = uc($a); # taint $b s/(.+)/$b/; # this must taint only the $_ -check_taint 48, $_; -check_taint_not 49, $&; -check_taint_not 50, $`; -check_taint_not 51, $'; -check_taint_not 52, $+; -check_taint_not 53, $1; -check_taint_not 54, $2; +check_taint 54, $_; +check_taint_not 55, $&; +check_taint_not 56, $`; +check_taint_not 57, $'; +check_taint_not 58, $+; +check_taint_not 59, $1; +check_taint_not 60, $2; $_ = $a; # untaint $_ s/(.+)/b/; # this must not taint -check_taint_not 55, $_; -check_taint_not 56, $&; -check_taint_not 57, $`; -check_taint_not 58, $'; -check_taint_not 59, $+; -check_taint_not 60, $1; -check_taint_not 61, $2; +check_taint_not 61, $_; +check_taint_not 62, $&; +check_taint_not 63, $`; +check_taint_not 64, $'; +check_taint_not 65, $+; +check_taint_not 66, $1; +check_taint_not 67, $2; + +$b = $a; # untaint $b + +($b = $a) =~ s/\w/$&/; +check_taint 68, $b; # $b should be tainted. +check_taint_not 69, $a; # $a should be not. + +$_ = $a; # untaint $_ + +s/(\w)/\l$1/; # this must taint +check_taint 70, $_; +check_taint 71, $&; +check_taint 72, $`; +check_taint 73, $'; +check_taint 74, $+; +check_taint 75, $1; +check_taint_not 76, $2; + +$_ = $a; # untaint $_ + +s/(\w)/\L$1/; # this must taint +check_taint 77, $_; +check_taint 78, $&; +check_taint 79, $`; +check_taint 80, $'; +check_taint 81, $+; +check_taint 82, $1; +check_taint_not 83, $2; + +$_ = $a; # untaint $_ + +s/(\w)/\u$1/; # this must taint +check_taint 84, $_; +check_taint 85, $&; +check_taint 86, $`; +check_taint 87, $'; +check_taint 88, $+; +check_taint 89, $1; +check_taint_not 90, $2; -check_taint_not 62, $a; +$_ = $a; # untaint $_ + +s/(\w)/\U$1/; # this must taint +check_taint 91, $_; +check_taint 92, $&; +check_taint 93, $`; +check_taint 94, $'; +check_taint 95, $+; +check_taint 96, $1; +check_taint_not 97, $2; + +# After all this tainting $a should be cool. + +check_taint_not 98, $a; # I think we've seen quite enough of taint. # Let us do some *real* locale work now. @@ -246,7 +306,8 @@ for (@Locale) { # Cross-check the upper and the lower. # Yes, this is broken when the upper<->lower changes the number of -# the glyphs (e.g. the German sharp-s aka double-s aka sz-ligature. +# the glyphs (e.g. the German sharp-s aka double-s aka sz-ligature, +# or the Dutch IJ or the Spanish LL or ...) # But so far all the implementations do this wrong so we can do it wrong too. for (keys %UPPER) { @@ -257,7 +318,7 @@ for (keys %UPPER) { } } } -print "ok 63\n"; +print "ok 99\n"; for (keys %lower) { if (defined $UPPER{$lower{$_}}) { @@ -267,7 +328,7 @@ for (keys %lower) { } } } -print "ok 64\n"; +print "ok 100\n"; # Find the alphabets that are not alphabets in the default locale. @@ -290,15 +351,18 @@ print "ok 64\n"; print 'not ' if ($1 ne $word); } -print "ok 65\n"; +print "ok 101\n"; # Find places where the collation order differs from the default locale. { - no locale; + my (@k, $i, $j, @d); - my @k = sort (keys %UPPER, keys %lower); - my ($i, $j, @d); + { + no locale; + + @k = sort (keys %UPPER, keys %lower); + } for ($i = 0; $i < @k; $i++) { for ($j = $i + 1; $j < @k; $j++) { @@ -312,10 +376,15 @@ print "ok 65\n"; for (@d) { ($i, $j) = @$_; - print 'not ' if ($i le $j or not (($i cmp $j) == 1)); + if ($i gt $j) { + print "# i = $i, j = $j, i ", + $i le $j ? 'le' : 'gt', " j\n"; + print 'not '; + last; + } } } -print "ok 66\n"; +print "ok 102\n"; # Cross-check whole character set. @@ -325,7 +394,47 @@ for (map { chr } 0..255) { if (/\s/ and /\S/) { print 'not '; last } if (/\w/ and /\D/ and not /_/ and not (exists $UPPER{$_} or exists $lower{$_})) { - print 'not '; last + print 'not '; + last; + } +} +print "ok 103\n"; + +# The @Locale should be internally consistent. + +{ + my ($from, $to, , $lesser, $greater); + + for (0..9) { + # Select a slice. + $from = int(($_*@Locale)/10); + $to = $from + int(@Locale/10); + $to = $#Locale if ($to > $#Locale); + $lesser = join('', @Locale[$from..$to]); + # Select a slice one character on. + $from++; $to++; + $to = $#Locale if ($to > $#Locale); + $greater = join('', @Locale[$from..$to]); + if (not ($lesser lt $greater) or + not ($lesser le $greater) or + not ($lesser ne $greater) or + ($lesser eq $greater) or + ($lesser ge $greater) or + ($lesser gt $greater) or + ($greater lt $lesser ) or + ($greater le $lesser ) or + not ($greater ne $lesser ) or + ($greater eq $lesser ) or + not ($greater ge $lesser ) or + not ($greater gt $lesser ) or + # Well, these two are sort of redundant because @Locale + # was derived using cmp. + not (($lesser cmp $greater) == -1) or + not (($greater cmp $lesser ) == 1) + ) { + print 'not '; + last; + } } } -print "ok 67\n"; +print "ok 104\n"; |