t/op/utftaint.t

   1 #!./perl -T
   2 # tests whether tainting works with UTF-8
   3
   4 BEGIN {
   5     if ($ENV{PERL_CORE_MINITEST}) {
   6         print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
   7         exit 0;
   8     }
   9     chdir 't' if -d 't';
  10     @INC = qw(../lib);
  11 }
  12
  13 use strict;
  14 use Config;
  15
  16 BEGIN {
  17     if ($Config{extensions} !~ m(\bList/Util\b)) {
  18         print "1..0 # Skip: no Scalar::Util module\n";
  19         exit 0;
  20     }
  21 }
  22
  23 use Scalar::Util qw(tainted);
  24
  25 use Test;
  26 plan tests => 3*10;
  27 my $cnt = 0;
  28
  29 my $arg = $ENV{PATH}; # a tainted value
  30 use constant UTF8 => "\x{1234}";
  31
  32 for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
  33     my $encode = $ary->[0];
  34     my $string = $ary->[1];
  35
  36     my $taint = $arg; substr($taint, 0) = $ary->[1];
  37
  38     print tainted($taint) == tainted($arg)
  39         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, before test\n";
  40
  41     my $lconcat = $taint;
  42        $lconcat .= UTF8;
  43     print $lconcat eq $string."\x{1234}"
  44         ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat left\n";
  45
  46     print tainted($lconcat) == tainted($arg)
  47         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat left\n";
  48
  49     my $rconcat = UTF8;
  50        $rconcat .= $taint;
  51     print $rconcat eq "\x{1234}".$string
  52         ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat right\n";
  53
  54     print tainted($rconcat) == tainted($arg)
  55         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat right\n";
  56
  57     my $ljoin = join('!', $taint, UTF8);
  58     print $ljoin eq join('!', $string, UTF8)
  59         ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join left\n";
  60
  61     print tainted($ljoin) == tainted($arg)
  62         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join left\n";
  63
  64     my $rjoin = join('!', UTF8, $taint);
  65     print $rjoin eq join('!', UTF8, $string)
  66         ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join right\n";
  67
  68     print tainted($rjoin) == tainted($arg)
  69         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join right\n";
  70
  71     print tainted($taint) == tainted($arg)
  72         ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, after test\n";
  73 }