t/taint/rx.t

   1 #!/usr/bin/env perl -T
   2
   3 =pod
   4
   5 Equivalent to F<taint/util.t> but uses perl regexes to untaint.
   6
   7 =cut
   8
   9 use strict;
  10 use Test::More;
  11
  12 BEGIN {
  13     eval {
  14         require Taint::Util;
  15         Taint::Util->import;
  16     };
  17
  18     plan $@
  19         ? (skip_all => "Taint::Util required for taint tests")
  20         : (tests => 8);
  21 }
  22
  23 use re::engine::Plugin (
  24     exec => sub {
  25         my ($re, $str) = @_;
  26
  27         ok(tainted($str) => 'matched string tainted');
  28
  29         my $one = $str;
  30         my $two = $str; $two ~~ /(.*)/; $two = $1;
  31
  32         ok(tainted($one));
  33         ok(!tainted($two));
  34
  35         $re->num_captures(
  36             FETCH => sub {
  37                 my ($re, $p) = @_;
  38
  39                 return $one if $p == 1;
  40                 return $two if $p == 2;
  41             },
  42         );
  43
  44         1;
  45     }
  46 );
  47
  48 my $str = "string";
  49 taint($str);
  50 ok(tainted($str));
  51
  52 if ($str =~ /pattern/) {
  53     cmp_ok $1, 'eq', $str;
  54     ok(tainted($1) => '$1 is tainted');
  55
  56     cmp_ok $2, 'eq', $str;
  57     ok(!tainted($2) => '$2 is untainted');
  58 }