diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/op/utftaint.t')
| -rw-r--r-- | gnu/usr.bin/perl/t/op/utftaint.t | 186 |
1 files changed, 186 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/t/op/utftaint.t b/gnu/usr.bin/perl/t/op/utftaint.t new file mode 100644 index 00000000000..cd44503e749 --- /dev/null +++ b/gnu/usr.bin/perl/t/op/utftaint.t @@ -0,0 +1,186 @@ +#!./perl -T +# tests whether tainting works with UTF-8 + +BEGIN { + if ($ENV{PERL_CORE_MINITEST}) { + print "1..0 # Skip: no dynamic loading on miniperl, no threads\n"; + exit 0; + } + chdir 't' if -d 't'; + @INC = qw(../lib); +} + +use strict; +use Config; + +BEGIN { + if ($Config{extensions} !~ m(\bList/Util\b)) { + print "1..0 # Skip: no Scalar::Util module\n"; + exit 0; + } +} + +use Scalar::Util qw(tainted); + +use Test; +plan tests => 3*10 + 3*8 + 2*16; +my $cnt = 0; + +my $arg = $ENV{PATH}; # a tainted value +use constant UTF8 => "\x{1234}"; + +sub is_utf8 { + my $s = shift; + return 0xB6 != ord pack('a*', chr(0xB6).$s); +} + +for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) { + my $encode = $ary->[0]; + my $string = $ary->[1]; + + my $taint = $arg; substr($taint, 0) = $ary->[1]; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, before test\n"; + + my $lconcat = $taint; + $lconcat .= UTF8; + print $lconcat eq $string.UTF8 + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat left\n"; + + print tainted($lconcat) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat left\n"; + + my $rconcat = UTF8; + $rconcat .= $taint; + print $rconcat eq UTF8.$string + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat right\n"; + + print tainted($rconcat) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat right\n"; + + my $ljoin = join('!', $taint, UTF8); + print $ljoin eq join('!', $string, UTF8) + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join left\n"; + + print tainted($ljoin) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join left\n"; + + my $rjoin = join('!', UTF8, $taint); + print $rjoin eq join('!', UTF8, $string) + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join right\n"; + + print tainted($rjoin) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join right\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, after test\n"; +} + + +for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) { + my $encode = $ary->[0]; + + my $utf8 = pack('U*') . $ary->[1]; + my $byte = pack('C0a*', $utf8); + + my $taint = $arg; substr($taint, 0) = $utf8; + utf8::encode($taint); + + print $taint eq $byte + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, encode utf8\n"; + + print pack('a*',$taint) eq pack('a*',$byte) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, encode utf8\n"; + + print !is_utf8($taint) + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, encode utf8\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, encode utf8\n"; + + my $taint = $arg; substr($taint, 0) = $byte; + utf8::decode($taint); + + print $taint eq $utf8 + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, decode byte\n"; + + print pack('a*',$taint) eq pack('a*',$utf8) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, decode byte\n"; + + print is_utf8($taint) eq ($encode ne 'ascii') + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, decode byte\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, decode byte\n"; +} + + +for my $ary ([ascii => 'perl'], [latin1 => "\xB6"]) { + my $encode = $ary->[0]; + + my $up = pack('U*') . $ary->[1]; + my $down = pack('C0a*', $ary->[1]); + + my $taint = $arg; substr($taint, 0) = $up; + utf8::upgrade($taint); + + print $taint eq $up + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, upgrade up\n"; + + print pack('a*',$taint) eq pack('a*',$up) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, upgrade up\n"; + + print is_utf8($taint) + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, upgrade up\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, upgrade up\n"; + + my $taint = $arg; substr($taint, 0) = $down; + utf8::upgrade($taint); + + print $taint eq $up + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, upgrade down\n"; + + print pack('a*',$taint) eq pack('a*',$up) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, upgrade down\n"; + + print is_utf8($taint) + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, upgrade down\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, upgrade down\n"; + + my $taint = $arg; substr($taint, 0) = $up; + utf8::downgrade($taint); + + print $taint eq $down + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, downgrade up\n"; + + print pack('a*',$taint) eq pack('a*',$down) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, downgrade up\n"; + + print !is_utf8($taint) + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, downgrade up\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, downgrade up\n"; + + my $taint = $arg; substr($taint, 0) = $down; + utf8::downgrade($taint); + + print $taint eq $down + ? "ok " : "not ok ", ++$cnt, " # compare: $encode, downgrade down\n"; + + print pack('a*',$taint) eq pack('a*',$down) + ? "ok " : "not ok ", ++$cnt, " # bytecmp: $encode, downgrade down\n"; + + print !is_utf8($taint) + ? "ok " : "not ok ", ++$cnt, " # is_utf8: $encode, downgrade down\n"; + + print tainted($taint) == tainted($arg) + ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, downgrade down\n"; +} + + |