Login
svn merge -r 2029:2018 ProhibitNegativeExpressionsInUnlessAndUntilConditions.run.PL
[gknop/Perl-Critic.git] / t / ControlStructures / ProhibitNegativeExpressionsInUnlessAndUntilConditions.run.PL
1 #!/usr/bin/env perl
2
3 use strict;
4 use warnings;
5
6 use English qw{-no_match_vars};
7
8 use Carp qw{ confess };
9 use Fatal qw{ open close };
10
11 our $VERSION = '1.080';
12
13
14
15 my $this_program = __FILE__;
16 (my $test_file_name = $this_program) =~ s/ \.PL \z //xms;
17 if ($this_program eq $test_file_name) {
18     confess
19         'Was not able to figure out the name of the file to generate.'
20         . "This program: $this_program.";
21 }
22
23 print "\n\nGenerating $test_file_name.\n";
24
25
26
27 open my $test_file, '>', $test_file_name
28     or die "Could not open $test_file_name: $ERRNO";
29
30
31 print {$test_file} <<"END_HEADER";
32 # Do not edit!!!  This test suite generated by $this_program.
33 END_HEADER
34
35 foreach my $operator ( qw/ ! not / ) {
36     emit_not_operator_code($test_file, $operator);
37 }
38 emit_not_match_code($test_file);
39 foreach my $operator ( qw/ ne != < > <= >= <=> lt gt le ge cmp / ) {
40     emit_comparator_code($test_file, $operator);
41 }
42
43
44 close $test_file;
45 print "Done.\n\n";
46
47 #-----------------------------------------------------------------------------
48
49 sub emit_not_operator_code {
50     my ($test_file, $operator) = @_;
51
52     print {$test_file} <<"END_NOT_OPERATOR_CODE";
53
54 ## name "$operator" within positive control structures
55 ## failures 0
56 ## cut
57
58 if ($operator \$foo) {
59     blah();
60 }
61
62 if (\$foo) {
63     blah(\$foo);
64 }
65 elsif ($operator \$bar) {
66     blah(\$bar);
67 }
68 else {
69     blah(undef);
70 }
71
72 while ($operator \$foo) {
73     blah();
74 }
75
76 foreach my \$bar ( grep { $operator \$_ } \@foo ) {
77     blah(\$bar);
78 }
79
80 for (my \$bar = 0; $operator \$bar; \$bar++) {
81     blah(\$bar);
82 }
83
84 #-----------------------------------------------------------------------------
85
86 ## name "$operator" within positive postfix statement modifiers
87 ## failures 0
88 ## cut
89
90 blah() if $operator \$foo;
91
92 blah() while $operator \$foo;
93
94 blah(\$_) for grep { $operator \$_ } \@foo;
95
96 #-----------------------------------------------------------------------------
97
98 ## name "$operator" within negative control structures
99 ## failures 2
100 ## cut
101
102 unless ($operator \$foo) {
103     blah();
104 }
105
106 until ($operator \$foo) {
107     blah();
108 }
109
110 #-----------------------------------------------------------------------------
111
112 ## name "$operator" within negative postfix statement modifiers
113 ## failures 2
114 ## cut
115
116 blah() unless $operator \$foo;
117
118 blah() until $operator \$foo;
119
120 #-----------------------------------------------------------------------------
121 END_NOT_OPERATOR_CODE
122 }
123
124 #-----------------------------------------------------------------------------
125
126 sub emit_not_match_code {
127     my ($test_file) = @_;
128
129     print {$test_file} <<'END_NOT_MATCH_CODE';
130
131 ## name "!~" within positive control structures
132 ## failures 0
133 ## cut
134
135 if ($foo !~ m/bar/) {
136     blah();
137 }
138
139 if ($foo) {
140     blah($foo);
141 }
142 elsif ($bar !~ m/bar/) {
143     blah($bar);
144 }
145 else {
146     blah(undef);
147 }
148
149 while ($foo !~ m/bar/) {
150     blah();
151 }
152
153 foreach my $bar ( grep { $_ !~ m/baz/ } @foo ) {
154     blah($bar);
155 }
156
157 for (my $bar = 0; $bar =~ m/baz/; $bar++) {
158     blah($bar);
159 }
160
161 #-----------------------------------------------------------------------------
162
163 ## name "!~" within positive postfix statement modifiers
164 ## failures 0
165 ## cut
166
167 blah() if $foo !~ m/bar/;
168
169 blah() while $foo !~ m/bar/;
170
171 blah($_) for grep { $_ !~ m/bar/ } @foo;
172
173 #-----------------------------------------------------------------------------
174
175 ## name "!~" within negative control structures
176 ## failures 2
177 ## cut
178
179 unless ($foo !~ m/bar/) {
180     blah();
181 }
182
183 until ($foo !~ m/bar/) {
184     blah();
185 }
186
187 #-----------------------------------------------------------------------------
188
189 ## name "!~" within negative postfix statement modifiers
190 ## failures 2
191 ## cut
192
193 blah() unless $foo !~ m/bar/;
194
195 blah() until $foo !~ m/bar/;
196
197 #-----------------------------------------------------------------------------
198 END_NOT_MATCH_CODE
199 }
200
201 #-----------------------------------------------------------------------------
202
203 sub emit_comparator_code {
204     my ($test_file, $operator) = @_;
205
206     print {$test_file} <<"END_COMPARATOR_CODE";
207
208 ## name "$operator" within positive control structures
209 ## failures 0
210 ## cut
211
212 if (\$foo $operator \$bar) {
213     blah();
214 }
215
216 if (\$foo $operator \$bar) {
217     blah(\$foo);
218 }
219 elsif (\$bar $operator \$baz) {
220     blah(\$bar);
221 }
222 else {
223     blah(undef);
224 }
225
226 while (\$foo $operator \$bar) {
227     blah();
228 }
229
230 foreach my \$bar ( grep { \$_ $operator \$baz } \@foo ) {
231     blah(\$bar);
232 }
233
234 for (my \$bar = 0; \$bar $operator \$baz; \$bar++) {
235     blah(\$bar);
236 }
237
238 #-----------------------------------------------------------------------------
239
240 ## name "$operator" within positive postfix statement modifiers
241 ## failures 0
242 ## cut
243
244 blah() if \$foo $operator \$bar;
245
246 blah() while \$foo $operator \$bar;
247
248 blah(\$_) for grep { \$_ $operator \$bar } \@foo;
249
250 #-----------------------------------------------------------------------------
251
252 ## name "$operator" within negative control structures
253 ## failures 2
254 ## cut
255
256 unless (\$foo $operator \$bar) {
257     blah();
258 }
259
260 until (\$foo $operator \$bar) {
261     blah();
262 }
263
264 #-----------------------------------------------------------------------------
265
266 ## name "$operator" within negative postfix statement modifiers
267 ## failures 2
268 ## cut
269
270 blah() unless \$foo $operator \$bar;
271
272 blah() until \$foo $operator \$bar;
273
274 #-----------------------------------------------------------------------------
275 END_COMPARATOR_CODE
276 }
277
278 #-----------------------------------------------------------------------------
279
280
281 ##############################################################################
282 #      $URL$
283 #     $Date$
284 #   $Author$
285 # $Revision$
286 ##############################################################################
287
288 # Local Variables:
289 #   mode: cperl
290 #   cperl-indent-level: 4
291 #   fill-column: 78
292 #   indent-tabs-mode: nil
293 #   c-indentation-style: bsd
294 # End:
295 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :