2 # tests whether tainting works with UTF-8
5 if ($ENV{PERL_CORE_MINITEST}) {
6 print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
17 if ($Config{extensions} !~ m(\bList/Util\b)) {
18 print "1..0 # Skip: no Scalar::Util module\n";
23 use Scalar::Util qw(tainted);
29 my $arg = $ENV{PATH}; # a tainted value
30 use constant UTF8 => "\x{1234}";
32 for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
33 my $encode = $ary->[0];
34 my $string = $ary->[1];
36 my $taint = $arg; substr($taint, 0) = $ary->[1];
38 print tainted($taint) == tainted($arg)
39 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, before test\n";
43 print $lconcat eq $string."\x{1234}"
44 ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat left\n";
46 print tainted($lconcat) == tainted($arg)
47 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat left\n";
51 print $rconcat eq "\x{1234}".$string
52 ? "ok " : "not ok ", ++$cnt, " # compare: $encode, concat right\n";
54 print tainted($rconcat) == tainted($arg)
55 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, concat right\n";
57 my $ljoin = join('!', $taint, UTF8);
58 print $ljoin eq join('!', $string, UTF8)
59 ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join left\n";
61 print tainted($ljoin) == tainted($arg)
62 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join left\n";
64 my $rjoin = join('!', UTF8, $taint);
65 print $rjoin eq join('!', UTF8, $string)
66 ? "ok " : "not ok ", ++$cnt, " # compare: $encode, join right\n";
68 print tainted($rjoin) == tainted($arg)
69 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, join right\n";
71 print tainted($taint) == tainted($arg)
72 ? "ok " : "not ok ", ++$cnt, " # tainted: $encode, after test\n";