6 use Test::More tests => 2 * (4 + 2 + 7 + 8 + 6 + 2) * 3;
11 my ($rw, $s, $x, $y) = @_;
12 $y = $x unless defined $y;
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.']');
20 my ($t, $one, $any) = @_;
22 my $rw = Regexp::Wildcards->new;
27 try $rw, "simple $any", $any, '.*';
28 try $rw, "simple $one", $one, '.';
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]");
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]");
46 try $rw, "multiple $any", $any x 2, '.*';
47 try $rw, "multiple $one", $one x 2, '..';
51 $rw->capture('single');
52 try $rw, "multiple capturing $one", $one.$one.'\\'.$one.$one,
53 '(.)(.)\\'.$one.'(.)';
55 $rw->capture(add => [ qw/any greedy/ ]);
56 try $rw, "multiple capturing $any (greedy)", $any.$any.'\\'.$any.$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.'(.*)';
62 $rw->capture(set => [ qw/any greedy/ ]);
63 try $rw, "multiple capturing $any (greedy) and non-capturing $one",
64 $wc, '(.*)..\\'.$one.'.\\'.$any.'(.*)';
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.'(.*?)';
72 $rw->capture({ single => 1, any => 1 });
73 try $rw, "multiple capturing $any (non-greedy) and capturing $one",
74 $wc, '(.*?)(.)(.)\\'.$one.'(.)\\'.$any.'(.*?)';
80 try $rw, "escaping $any", '\\'.$any;
81 try $rw, "escaping $any before intermediate newline", '\\'.$any ."\n\\".$any;
82 try $rw, "escaping $one", '\\'.$one;
83 try $rw, "escaping $one before intermediate newline", '\\'.$one ."\n\\".$one;
84 try $rw, "escaping \\\\\\$any", '\\\\\\'.$any;
85 try $rw, "escaping \\\\\\$one", '\\\\\\'.$one;
86 try $rw, "not escaping \\\\$any", '\\\\'.$any, '\\\\.*';
87 try $rw, "not escaping \\\\$one", '\\\\'.$one, '\\\\.';
91 try $rw, 'escaping \\', '\\', '\\\\';
92 try $rw, 'not escaping \\', '\\\\', '\\\\';
93 try $rw, 'escaping \\ before intermediate newline', "\\\n\\", "\\\\\n\\\\";
94 try $rw, 'not escaping \\ before intermediate newline', "\\\\\n\\\\", "\\\\\n\\\\";
95 try $rw, 'escaping regex characters', '[]', '\\[\\]';
96 try $rw, 'not escaping escaped regex characters', '\\\\\\[\\]';
100 try $rw, "mixed $any and \\$any", $any.'\\'.$any.$any, '.*\\'.$any.'.*';
101 try $rw, "mixed $one and \\$one", $one.'\\'.$one.$one, '.\\'.$one.'.';
104 alltests 'jokers', '?', '*';
105 alltests 'sql', '_', '%';