1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#!/usr/bin/perl
use strict;
use lib "blib/lib", ".";
use Regexp::Common qw /RE_comment_HTML/;
use t::Common qw /run_new_tests cross/;
use warnings;
my @good = ("", "This is a comment", "This is - a comment",
"This is - - comment", ">This is a comment",
">This is a comment<", "This is <a> comment",
">", "<>", "><", "<");
my @spec = ("", ">", "->", "<!", "-<");
sub ss {(!@_ && 1 < rand 4) ? "" :
(1 < rand 4) ? "\n" :
(1 < rand 3) ? "\t" : " " x (1 + rand 5)};
my @spaced = map {[$_, ss (1)]} @good;
my @crossed = cross \@good, \@good;
my @cross3 = map {[$_ -> [0], ss, $_ -> [1], ss, $_ -> [2], ss]}
cross \@spec, \@spec, \@spec;
# Targets, and test suites.
my %targets;
my @tests;
$targets {simple} = {
list => \@good,
query => sub {"<!--$_[0]-->"},
wanted => sub {$_, "<!", "--$_[0]--", $_ [0], ">"},
};
$targets {simple_space} = {
list => \@spaced,
query => sub {"<!--$_[0]--$_[1]>"},
wanted => sub {$_, "<!", "--$_[0]--$_[1]", $_ [0], ">"},
};
$targets {crossed} = {
list => \@crossed,
query => sub {"<!--$_[0]----$_[1]-->"},
wanted => sub {$_, "<!", "--$_[0]----$_[1]--", $_ [1], ">"},
};
$targets {crossed2} = {
list => \@cross3,
query => sub {"<!--$_[0]--$_[1]--$_[2]--$_[3]--$_[4]--$_[5]>"},
wanted => sub {$_, "<!",
"--$_[0]--$_[1]--$_[2]--$_[3]--$_[4]--$_[5]",
$_ [4], ">"},
};
my @bad = map {("<--$_-->", # Missing !
"<!-$_-->", # Not enough dashes,
"<!--$_->", # Again.
"<!----$_-->", # Too many starting dashes.
"<! --$_-->", # Space after <!
"<!--$_--!>", # Garbage after comment
)} @good;
$targets {bad1} = {
list => \@bad,
};
$targets {bad2} = {
list => \@crossed,
query => sub {"<!--$_[0]--$_[1]-->"},
};
push @tests => {
name => 'HTML',
regex => $RE {comment} {HTML},
pass => [qw /simple simple_space crossed crossed2/],
fail => [qw /bad1 bad2/],
sub => \&RE_comment_HTML,
};
run_new_tests tests => \@tests,
targets => \%targets,
version_from => 'Regexp::Common::comment',
;
__END__
|
