Re: [PATCH] [perl #29841] utf8::decode doesn't work under -T

[p5sagit/p5-mst-13.2.git] / t / op / utftaint.t

diff --git a/t/op/utftaint.t b/t/op/utftaint.t
index 692c908..cd44503 100644 (file)
--- a/t/op/utftaint.t
+++ b/t/op/utftaint.t
@@ -23,12 +23,17 @@ BEGIN {
 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];
@@ -40,7 +45,7 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
 
     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)
@@ -48,7 +53,7 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
 
     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)
@@ -71,3 +76,111 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
     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";
+}
+
+