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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#!/usr/bin/perl
# Unit testing for PPI::Token::QuoteLike::Words
use lib 't/lib';
use PPI::Test::pragmas;
use Test::More tests => 1940 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
use Test::Deep;
use PPI;
sub permute_test;
sub assemble_and_run;
my %known_bad = map { $_ => 1 } "qw ' \\' '", "qw ( \\( )", "qw ( \\) )", "qw / \\/ /", "qw 1 a \\1 1", "qw < \\< >", "qw < \\> >", "qw [ \\[ ]", "qw [ \\] ]", "qw \" \\\" \"", "qw a \\a a", "qw { \\{ }", "qw { \\} }", "qw# \\# #", "qw#\\##", "qw#\n\\#\n#", "qw' \\' '", "qw'\\''", "qw'\f\\'\f'", "qw'\n\\'\n'", "qw'\t\\'\t'", "qw( \\( )", "qw( \\) )", "qw( \\\\ )", "qw(\\()", "qw(\\))", "qw(\f\\(\f)", "qw(\f\\)\f)", "qw(\n\\(\n)", "qw(\n\\)\n)", "qw(\n\\\\\n)", "qw(\t\\(\t)", "qw(\t\\)\t)", "qw/ \\/ /", "qw/\\//", "qw/\f\\/\f/", "qw/\n\\/\n/", "qw/\t\\/\t/", "qw< \\< >", "qw< \\> >", "qw<\\<>", "qw<\\>>", "qw<\f\\<\f>", "qw<\f\\>\f>", "qw<\n\\<\n>", "qw<\n\\>\n>", "qw<\t\\<\t>", "qw<\t\\>\t>", "qw[ \\[ ]", "qw[ \\] ]", "qw[\\[]", "qw[\\]]", "qw[\f\\[\f]", "qw[\f\\]\f]", "qw[\n\\[\n]", "qw[\n\\]\n]", "qw[\t\\[\t]", "qw[\t\\]\t]", "qw\" \\\" \"", "qw\"\\\"\"", "qw\"\f\\\"\f\"", "qw\"\n\\\"\n\"", "qw\"\t\\\"\t\"", "qw\f'\f\\'\f'", "qw\f(\f\\(\f)", "qw\f(\f\\)\f)", "qw\f/\f\\/\f/", "qw\f<\f\\<\f>", "qw\f<\f\\>\f>", "qw\f[\f\\[\f]", "qw\f[\f\\]\f]", "qw\f\"\f\\\"\f\"", "qw\f{\f\\{\f}", "qw\f{\f\\}\f}", "qw\n'\n\\'\n'", "qw\n(\n\\(\n)", "qw\n(\n\\)\n)", "qw\n/\n\\/\n/", "qw\n<\n\\<\n>", "qw\n<\n\\>\n>", "qw\n[\n\\[\n]", "qw\n[\n\\]\n]", "qw\n\"\n\\\"\n\"", "qw\na\n\\a\na", "qw\n{\n\\{\n}", "qw\n{\n\\}\n}", "qw\t'\t\\'\t'", "qw\t(\t\\(\t)", "qw\t(\t\\)\t)", "qw\t/\t\\/\t/", "qw\t<\t\\<\t>", "qw\t<\t\\>\t>", "qw\t[\t\\[\t]", "qw\t[\t\\]\t]", "qw\t\"\t\\\"\t\"", "qw\t{\t\\{\t}", "qw\t{\t\\}\t}", "qw{ \\{ }", "qw{ \\} }", "qw{\\{}", "qw{\\}}", "qw{\f\\{\f}", "qw{\f\\}\f}", "qw{\n\\{\n}", "qw{\n\\}\n}", "qw{\t\\{\t}", "qw{\t\\}\t}";
LITERAL: {
# empty
permute_test [], '/', '/', [];
permute_test [], '"', '"', [];
permute_test [], "'", "'", [];
permute_test [], '(', ')', [];
permute_test [], '{', '}', [];
permute_test [], '[', ']', [];
permute_test [], '<', '>', [];
# words
permute_test ['a', 'b', 'c'], '/', '/', ['a', 'b', 'c'];
permute_test ['a,', 'b', 'c,'], '/', '/', ['a,', 'b', 'c,'];
permute_test ['a', ',', '#', 'c'], '/', '/', ['a', ',', '#', 'c'];
permute_test ['f_oo', 'b_ar'], '/', '/', ['f_oo', 'b_ar'];
# it's allowed for both delims to be closers
permute_test ['a'], ')', ')', ['a'];
permute_test ['a'], '}', '}', ['a'];
permute_test ['a'], ']', ']', ['a'];
permute_test ['a'], '>', '>', ['a'];
# containing things that sometimes are delimiters
permute_test ['/'], '(', ')', ['/'];
permute_test ['//'], '(', ')', ['//'];
permute_test ['qw()'], '(', ')', ['qw()'];
permute_test ['qw', '()'], '(', ')', ['qw', '()'];
permute_test ['qw//'], '(', ')', ['qw//'];
# nested delimiters
permute_test ['()'], '(', ')', ['()'];
permute_test ['{}'], '{', '}', ['{}'];
permute_test ['[]'], '[', ']', ['[]'];
permute_test ['<>'], '<', '>', ['<>'];
permute_test ['((', ')', ')'], '(', ')', ['((', ')', ')'];
permute_test ['{{', '}', '}'], '{', '}', ['{{', '}', '}'];
permute_test ['[[', ']', ']'], '[', ']', ['[[', ']', ']'];
permute_test ['<<', '>', '>'], '<', '>', ['<<', '>', '>'];
my $bs = '\\'; # a single backslash character
# escaped opening and closing
permute_test ["$bs)"], '(', ')', [')'];
permute_test ["$bs("], '(', ')', ['('];
permute_test ["$bs}"], '{', '}', ['}'];
permute_test [$bs.'{'], '{', '}', ['{'];
permute_test ["$bs]"], '[', ']', [']'];
permute_test [$bs.'['], '[', ']', ['['];
permute_test ["$bs<"], '<', '>', ['<'];
permute_test ["$bs>"], '<', '>', ['>'];
permute_test ["$bs/"], '/', '/', ['/'];
permute_test ["$bs'"], "'", "'", ["'"];
permute_test [$bs.'"'], '"', '"', ['"'];
# alphanum delims have to be separated from qw
assemble_and_run " ", ['a', "${bs}1"], '1', " ", " ", '1', ['a', '1'];
assemble_and_run " ", ["${bs}a"], 'a', " ", " ", 'a', ['a'];
assemble_and_run "\n", ["${bs}a"], 'a', "\n", "\n", 'a', ['a'];
# '#' delims cannot be separated from qw
assemble_and_run '', ['a'], '#', '', ' ', '#', ['a'];
assemble_and_run '', ['a'], '#', ' ', ' ', '#', ['a'];
assemble_and_run '', ["$bs#"], '#', '', ' ', '#', ['#'];
assemble_and_run '', ["$bs#"], '#', ' ', ' ', '#', ['#'];
assemble_and_run '', ["$bs#"], '#', "\n", "\n", '#', ['#'];
# a single backslash represents itself
assemble_and_run '', [$bs], '(', ' ', ' ', ')', [$bs];
assemble_and_run '', [$bs], '(', "\n", ' ', ')', [$bs];
# a double backslash represents itself
assemble_and_run '', ["$bs$bs"], '(', ' ', ' ', ')', [$bs];
assemble_and_run '', ["$bs$bs"], '(', "\n", ' ', ')', [$bs];
# even backslash can be a delimiter, in when it is, backslashes
# can't be embedded or escaped.
assemble_and_run '', [], $bs, ' ', ' ', $bs, [];
assemble_and_run '', [], $bs, "\n", "\n", $bs, [];
assemble_and_run '', ['a'], $bs, '', ' ', $bs, ['a'];
assemble_and_run ' ', ['a'], $bs, '', ' ', $bs, ['a'];
assemble_and_run "\n", ['a'], $bs, '', ' ', $bs, ['a'];
}
sub execute_test {
my ( $code, $expected, $msg ) = @_;
my $d = PPI::Document->new( \$code );
isa_ok( $d, 'PPI::Document', $msg );
my $found = $d->find( 'PPI::Token::QuoteLike::Words' ) || [];
is( @$found, 1, "$msg - exactly one qw" );
is( $found->[0]->content, $code, "$msg content()" );
is_deeply( [ $found->[0]->literal ], $expected, "literal()" ); # can't dump $msg, as it breaks TODO parsing
return;
}
sub assemble_and_run {
my ( $pre_left_delim, $words_in, $left_delim, $delim_padding, $word_separator, $right_delim, $expected ) = @_;
my $code = "qw$pre_left_delim$left_delim$delim_padding" . join(' ', @$words_in) . "$delim_padding$right_delim";
execute_test $code, $expected, $code;
return;
}
sub permute_test {
my ( $words_in, $left_delim, $right_delim, $expected ) = @_;
assemble_and_run "", $words_in, $left_delim, "", " ", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "", "\t", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "", "\n", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "", "\f", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, " ", " ", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "\t", "\t", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "\n", "\n", $right_delim, $expected;
assemble_and_run "", $words_in, $left_delim, "\f", "\f", $right_delim, $expected;
assemble_and_run " ", $words_in, $left_delim, " ", " ", $right_delim, $expected;
assemble_and_run "\t", $words_in, $left_delim, "\t", "\t", $right_delim, $expected;
assemble_and_run "\n", $words_in, $left_delim, "\n", "\n", $right_delim, $expected;
assemble_and_run "\f", $words_in, $left_delim, "\f", "\f", $right_delim, $expected;
return;
}
|
