6 use Test::More tests => 4 * (4 + 2 + 7 + 9 + 2) * 3;
8 use Regexp::Wildcards qw/wc2re/;
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.']');
19 my ($t, $one, $any) = @_;
23 try $t, "simple $any", $any, '.*';
24 try $t, "simple $one", $one, '.';
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]");
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]");
42 try $t, "multiple $any", $any x 2, '.*';
43 try $t, "multiple $one", $one x 2, '..';
48 local $Regexp::Wildcards::CaptureSingle = 1;
49 try $t, "multiple capturing $one", $one.$one.'\\'.$one.$one,
50 '(.)(.)\\'.$one.'(.)';
52 local $Regexp::Wildcards::CaptureAny = 1;
53 try $t, "multiple capturing $any (greedy)", $any.$any.'\\'.$any.$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.'(.*)';
59 $Regexp::Wildcards::CaptureSingle = 0;
60 try $t, "multiple capturing $any (greedy) and non-capturing $one",
61 $wc, '(.*)..\\'.$one.'.\\'.$any.'(.*)';
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.'(.*?)';
69 $Regexp::Wildcards::CaptureSingle = 1;
70 try $t, "multiple capturing $any (non-greedy) and capturing $one",
71 $wc, '(.*?)(.)(.)\\'.$one.'(.)\\'.$any.'(.*?)';
76 try $t, "escaping $any", '\\'.$any;
77 try $t, "escaping $one", '\\'.$one;
78 try $t, "escaping \\\\\\$any", '\\\\\\'.$any;
79 try $t, "escaping \\\\\\$one", '\\\\\\'.$one;
81 try $t, "not escaping \\\\$any", '\\\\'.$any, '\\\\.*';
82 try $t, "not escaping \\\\$one", '\\\\'.$one, '\\\\.';
84 try $t, 'escaping \\', '\\', '\\\\';
85 try $t, 'escaping regex characters', '[]', '\\[\\]';
86 try $t, 'not escaping escaped regex characters', '\\\\\\[\\]';
90 try $t, "mixed $any and \\$any", $any.'\\'.$any.$any, '.*\\'.$any.'.*';
91 try $t, "mixed $one and \\$one", $one.'\\'.$one.$one, '.\\'.$one.'.';
94 alltests $_, '?', '*' for qw/jokers unix win32/;
95 alltests 'sql', '_', '%';