t/20-jokers.t

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