t/10-jokers.t

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