7 use English qw{-no_match_vars};
9 use Carp qw{ confess };
10 use Fatal qw{ open close };
12 our $VERSION = '1.088';
16 my $this_program = __FILE__;
17 (my $test_file_name = $this_program) =~ s/ \.PL \z //xms;
18 if ($this_program eq $test_file_name) {
20 'Was not able to figure out the name of the file to generate.'
21 . "This program: $this_program.";
24 print "\n\nGenerating $test_file_name.\n";
28 open my $test_file, '>', $test_file_name
29 or die "Could not open $test_file_name: $ERRNO";
32 print {$test_file} <<"END_HEADER";
33 # Do not edit!!! This test suite generated by $this_program.
36 foreach my $operator ( qw/ ! not / ) {
37 emit_not_operator_code($test_file, $operator);
39 emit_not_match_code($test_file);
40 foreach my $operator ( qw/ ne != < > <= >= <=> lt gt le ge cmp / ) {
41 emit_comparator_code($test_file, $operator);
48 #-----------------------------------------------------------------------------
50 sub emit_not_operator_code {
51 my ($test_file, $operator) = @_;
53 print {$test_file} <<"END_NOT_OPERATOR_CODE";
55 ## name "$operator" within positive control structures
59 if ($operator \$foo) {
66 elsif ($operator \$bar) {
73 while ($operator \$foo) {
77 foreach my \$bar ( grep { $operator \$_ } \@foo ) {
81 for (my \$bar = 0; $operator \$bar; \$bar++) {
85 #-----------------------------------------------------------------------------
87 ## name "$operator" within positive postfix statement modifiers
91 blah() if $operator \$foo;
93 blah() while $operator \$foo;
95 blah(\$_) for grep { $operator \$_ } \@foo;
97 #-----------------------------------------------------------------------------
99 ## name "$operator" within negative control structures
103 unless ($operator \$foo) {
107 until ($operator \$foo) {
111 #-----------------------------------------------------------------------------
113 ## name "$operator" within negative postfix statement modifiers
117 blah() unless $operator \$foo;
119 blah() until $operator \$foo;
121 #-----------------------------------------------------------------------------
122 END_NOT_OPERATOR_CODE
125 #-----------------------------------------------------------------------------
127 sub emit_not_match_code {
128 my ($test_file) = @_;
130 print {$test_file} <<'END_NOT_MATCH_CODE';
132 ## name "!~" within positive control structures
136 if ($foo !~ m/bar/) {
143 elsif ($bar !~ m/bar/) {
150 while ($foo !~ m/bar/) {
154 foreach my $bar ( grep { $_ !~ m/baz/ } @foo ) {
158 for (my $bar = 0; $bar =~ m/baz/; $bar++) {
162 #-----------------------------------------------------------------------------
164 ## name "!~" within positive postfix statement modifiers
168 blah() if $foo !~ m/bar/;
170 blah() while $foo !~ m/bar/;
172 blah($_) for grep { $_ !~ m/bar/ } @foo;
174 #-----------------------------------------------------------------------------
176 ## name "!~" within negative control structures
180 unless ($foo !~ m/bar/) {
184 until ($foo !~ m/bar/) {
188 #-----------------------------------------------------------------------------
190 ## name "!~" within negative postfix statement modifiers
194 blah() unless $foo !~ m/bar/;
196 blah() until $foo !~ m/bar/;
198 #-----------------------------------------------------------------------------
202 #-----------------------------------------------------------------------------
204 sub emit_comparator_code {
205 my ($test_file, $operator) = @_;
207 print {$test_file} <<"END_COMPARATOR_CODE";
209 ## name "$operator" within positive control structures
213 if (\$foo $operator \$bar) {
217 if (\$foo $operator \$bar) {
220 elsif (\$bar $operator \$baz) {
227 while (\$foo $operator \$bar) {
231 foreach my \$bar ( grep { \$_ $operator \$baz } \@foo ) {
235 for (my \$bar = 0; \$bar $operator \$baz; \$bar++) {
239 #-----------------------------------------------------------------------------
241 ## name "$operator" within positive postfix statement modifiers
245 blah() if \$foo $operator \$bar;
247 blah() while \$foo $operator \$bar;
249 blah(\$_) for grep { \$_ $operator \$bar } \@foo;
251 #-----------------------------------------------------------------------------
253 ## name "$operator" within negative control structures
257 unless (\$foo $operator \$bar) {
261 until (\$foo $operator \$bar) {
265 #-----------------------------------------------------------------------------
267 ## name "$operator" within negative postfix statement modifiers
271 blah() unless \$foo $operator \$bar;
273 blah() until \$foo $operator \$bar;
275 #-----------------------------------------------------------------------------
279 #-----------------------------------------------------------------------------
282 ##############################################################################
283 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.run.PL $
284 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
285 # $Author: clonezone $
287 ##############################################################################
291 # cperl-indent-level: 4
293 # indent-tabs-mode: nil
294 # c-indentation-style: bsd
296 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :