t/20-jokers.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2 * (4 + 2 + 7 + 9 + 2) * 3;
   7
   8 use Regexp::Wildcards;
   9
  10 sub try {
  11  my ($rw, $s, $x, $y) = @_;
  12  $y = $x unless defined $y;
  13  my $t = $rw->{type};
  14  is($rw->convert('ab' . $x),      'ab' . $y,      $s . ' (begin) ['.$t.']');
  15  is($rw->convert('a' . $x . 'b'), 'a' . $y . 'b', $s . ' (middle) ['.$t.']');
  16  is($rw->convert($x . 'ab'),      $y . 'ab',      $s . ' (end) ['.$t.']');
  17 }
  18
  19 sub alltests {
  20  my ($t, $one, $any) = @_;
  21
  22  my $rw = Regexp::Wildcards->new;
  23  $rw->type($t);
  24
  25  # Simple
  26
  27  try $rw, "simple $any", $any, '.*';
  28  try $rw, "simple $one", $one, '.';
  29
  30  is($rw->convert($one.$any.'ab', $t), '..*ab',
  31     "simple $one and $any (begin) [$t]");
  32  is($rw->convert($one.'a'.$any.'b', $t), '.a.*b',
  33     "simple $one and $any (middle) [$t]");
  34  is($rw->convert($one.'ab'.$any, $t), '.ab.*',
  35     "simple $one and $any (end) [$t]");
  36
  37  is($rw->convert($any.'ab'.$one, $t), '.*ab.',
  38     "simple $any and $one (begin) [$t]");
  39  is($rw->convert('a'.$any.'b'.$one, $t), 'a.*b.',
  40     "simple $any and $one (middle) [$t]");
  41  is($rw->convert('ab'.$any.$one, $t), 'ab.*.',
  42     "simple $any and $one (end) [$t]");
  43
  44  # Multiple
  45
  46  try $rw, "multiple $any", $any x 2, '.*';
  47  try $rw, "multiple $one", $one x 2, '..';
  48
  49  # Captures
  50
  51  $rw->capture('single');
  52  try $rw, "multiple capturing $one", $one.$one.'\\'.$one.$one,
  53                                     '(.)(.)\\'.$one.'(.)';
  54
  55  $rw->capture(add => [ qw/any greedy/ ]);
  56  try $rw, "multiple capturing $any (greedy)", $any.$any.'\\'.$any.$any,
  57                                               '(.*)\\'.$any.'(.*)';
  58  my $wc = $any.$any.$one.$one.'\\'.$one.$one.'\\'.$any.$any;
  59  try $rw, "multiple capturing $any (greedy) and capturing $one",
  60           $wc, '(.*)(.)(.)\\'.$one.'(.)\\'.$any.'(.*)';
  61
  62  $rw->capture(set => [ qw/any greedy/ ]);
  63  try $rw, "multiple capturing $any (greedy) and non-capturing $one",
  64           $wc, '(.*)..\\'.$one.'.\\'.$any.'(.*)';
  65
  66  $rw->capture(rem => 'greedy');
  67  try $rw, "multiple capturing $any (non-greedy)", $any.$any.'\\'.$any.$any,
  68                                                  '(.*?)\\'.$any.'(.*?)';
  69  try $rw, "multiple capturing $any (non-greedy) and non-capturing $one",
  70           $wc, '(.*?)..\\'.$one.'.\\'.$any.'(.*?)';
  71
  72  $rw->capture({ single => 1, any => 1 });
  73  try $rw, "multiple capturing $any (non-greedy) and capturing $one",
  74           $wc, '(.*?)(.)(.)\\'.$one.'(.)\\'.$any.'(.*?)';
  75
  76  $rw->capture();
  77
  78  # Escaping
  79
  80  try $rw, "escaping $any", '\\'.$any;
  81  try $rw, "escaping $one", '\\'.$one;
  82  try $rw, "escaping \\\\\\$any", '\\\\\\'.$any;
  83  try $rw, "escaping \\\\\\$one", '\\\\\\'.$one;
  84
  85  try $rw, "not escaping \\\\$any", '\\\\'.$any, '\\\\.*';
  86  try $rw, "not escaping \\\\$one", '\\\\'.$one, '\\\\.';
  87
  88  try $rw, 'escaping \\', '\\', '\\\\';
  89  try $rw, 'escaping regex characters', '[]', '\\[\\]';
  90  try $rw, 'not escaping escaped regex characters', '\\\\\\[\\]';
  91
  92  # Mixed
  93
  94  try $rw, "mixed $any and \\$any", $any.'\\'.$any.$any, '.*\\'.$any.'.*';
  95  try $rw, "mixed $one and \\$one", $one.'\\'.$one.$one, '.\\'.$one.'.';
  96 }
  97
  98 alltests 'jokers', '?', '*';
  99 alltests 'sql',    '_', '%';