X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Futftaint.t;h=cd44503e7491d1d1844b7e33a62eecb00051dfe8;hb=78ea37eb92d97de2362f1599aa0c3f43c5e70866;hp=692c9086683f5b991d22646b4684f08104d88789;hpb=e2736246f9096d0e04a2974deaf51d6950e0ac3f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/utftaint.t b/t/op/utftaint.t
index 692c908..cd44503 100644
--- 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";
+}
+
+