use Scalar::Util qw(tainted);
use Test;
-plan tests => 3*10;
+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 $lconcat = $taint;
$lconcat .= UTF8;
- print $lconcat eq $string."\x{1234}"
+ print $lconcat eq $string.UTF8
? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat left\n";
print tainted($lconcat) == tainted($arg)
my $rconcat = UTF8;
$rconcat .= $taint;
- print $rconcat eq "\x{1234}".$string
+ print $rconcat eq UTF8.$string
? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat right\n";
print tainted($rconcat) == tainted($arg)
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";
+}
+
+