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