Login
Generate
[gknop/Perl-Critic.git] / t / ControlStructures / ProhibitNegativeExpressionsInUnlessAndUntilConditions.run.PL
CommitLineData
9633a6db
ES
1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5
6use English qw{-no_match_vars};
7
8use Carp qw{ confess };
9use Fatal qw{ open close };
10
11our $VERSION = 1.078;
12
13
14
15my $this_program = __FILE__;
16(my $test_file_name = $this_program) =~ s/ \.PL \z //xms;
17if ($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
23print "Generating $test_file_name.\n";
24
25
26
27open my $test_file, '>', $test_file_name
28 or die "Could not open $test_file_name: $ERRNO";
29
30
31print {$test_file} <<"END_HEADER";
32# Do not edit!!! This test suite generated by $this_program.
33END_HEADER
34
35foreach my $operator ( qw/ ! not / ) {
36 emit_not_operator_code($test_file, $operator);
37}
38emit_not_match_code($test_file);
39foreach my $operator ( qw/ ne != < > <= >= <=> lt gt le ge cmp / ) {
40 emit_comparator_code($test_file, $operator);
41}
42
43
44close $test_file;
45print "Done.\n";
46
47#-----------------------------------------------------------------------------
48
49sub 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
58if ($operator \$foo) {
59 blah();
60}
61
62if (\$foo) {
63 blah(\$foo);
64}
65elsif ($operator \$bar) {
66 blah(\$bar);
67}
68else {
69 blah(undef);
70}
71
72while ($operator \$foo) {
73 blah();
74}
75
76foreach my \$bar ( grep { $operator \$_ } \@foo ) {
77 blah(\$bar);
78}
79
80for (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
90blah() if $operator \$foo;
91
92blah() while $operator \$foo;
93
94blah(\$_) for grep { $operator \$_ } \@foo;
95
96#-----------------------------------------------------------------------------
97
98## name "$operator" within negative control structures
99## failures 2
100## cut
101
102unless ($operator \$foo) {
103 blah();
104}
105
106until ($operator \$foo) {
107 blah();
108}
109
110#-----------------------------------------------------------------------------
111
112## name "$operator" within negative postfix statement modifiers
113## failures 2
114## cut
115
116blah() unless $operator \$foo;
117
118blah() until $operator \$foo;
119
120#-----------------------------------------------------------------------------
121END_NOT_OPERATOR_CODE
122}
123
124#-----------------------------------------------------------------------------
125
126sub 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
135if ($foo !~ m/bar/) {
136 blah();
137}
138
139if ($foo) {
140 blah($foo);
141}
142elsif ($bar !~ m/bar/) {
143 blah($bar);
144}
145else {
146 blah(undef);
147}
148
149while ($foo !~ m/bar/) {
150 blah();
151}
152
153foreach my $bar ( grep { $_ !~ m/baz/ } @foo ) {
154 blah($bar);
155}
156
157for (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
167blah() if $foo !~ m/bar/;
168
169blah() while $foo !~ m/bar/;
170
171blah($_) for grep { $_ !~ m/bar/ } @foo;
172
173#-----------------------------------------------------------------------------
174
175## name "!~" within negative control structures
176## failures 2
177## cut
178
179unless ($foo !~ m/bar/) {
180 blah();
181}
182
183until ($foo !~ m/bar/) {
184 blah();
185}
186
187#-----------------------------------------------------------------------------
188
189## name "!~" within negative postfix statement modifiers
190## failures 2
191## cut
192
193blah() unless $foo !~ m/bar/;
194
195blah() until $foo !~ m/bar/;
196
197#-----------------------------------------------------------------------------
198END_NOT_MATCH_CODE
199}
200
201#-----------------------------------------------------------------------------
202
203sub 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
212if (\$foo $operator \$bar) {
213 blah();
214}
215
216if (\$foo $operator \$bar) {
217 blah(\$foo);
218}
219elsif (\$bar $operator \$baz) {
220 blah(\$bar);
221}
222else {
223 blah(undef);
224}
225
226while (\$foo $operator \$bar) {
227 blah();
228}
229
230foreach my \$bar ( grep { \$_ $operator \$baz } \@foo ) {
231 blah(\$bar);
232}
233
234for (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
244blah() if \$foo $operator \$bar;
245
246blah() while \$foo $operator \$bar;
247
248blah(\$_) for grep { \$_ $operator \$bar } \@foo;
249
250#-----------------------------------------------------------------------------
251
252## name "$operator" within negative control structures
253## failures 2
254## cut
255
256unless (\$foo $operator \$bar) {
257 blah();
258}
259
260until (\$foo $operator \$bar) {
261 blah();
262}
263
264#-----------------------------------------------------------------------------
265
266## name "$operator" within negative postfix statement modifiers
267## failures 2
268## cut
269
270blah() unless \$foo $operator \$bar;
271
272blah() until \$foo $operator \$bar;
273
274#-----------------------------------------------------------------------------
275END_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 :