]> git.vpit.fr Git - perl/modules/Regexp-Wildcards.git/blob - t/20-jokers.t
This is 1.02
[perl/modules/Regexp-Wildcards.git] / t / 20-jokers.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 2 * (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 $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 $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, '\\\\.';
88
89  # Escaping escapes
90
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', '\\\\\\[\\]';
97
98  # Mixed
99
100  try $rw, "mixed $any and \\$any", $any.'\\'.$any.$any, '.*\\'.$any.'.*';
101  try $rw, "mixed $one and \\$one", $one.'\\'.$one.$one, '.\\'.$one.'.';
102 }
103
104 alltests 'jokers', '?', '*';
105 alltests 'sql',    '_', '%';