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