git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/InputOutput/RequireBriefOpen.run

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/InputOutput/RequireBriefOpen.run $
   3 #     $Date: 2008-05-11 17:44:01 -0500 (Sun, 11 May 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2335 $
   6 ##############################################################################
   7
   8 ## name open .. close
   9 ## failures 0
  10 ## cut
  11
  12 open my $fh1, '<', $filename or die;
  13 close $fh1;
  14 open my $fh2, '<', $filename or die;
  15 close $fh2;
  16 if (open my $fh3, '<', $filename) {
  17     close $fh3;
  18 }
  19
  20 my $fh4;
  21 open $fh4, '<', $filename or die;
  22 close $fh4;
  23
  24 #-----------------------------------------------------------------------------
  25
  26 ## name OO
  27 ## failures 0
  28 ## cut
  29
  30 open my $fh1, '<', $filename or die;
  31 $fh1->close;
  32
  33 #-----------------------------------------------------------------------------
  34
  35 ## name else
  36 ## failures 0
  37 ## cut
  38
  39 if (!open my $fh3, '<', $filename) {
  40     croak;
  41 } else {
  42     close $fh3;
  43 }
  44
  45 #-----------------------------------------------------------------------------
  46
  47 ## name while .. print
  48 ## failures 0
  49 ## cut
  50
  51 open my $fh1, '<', $filename or die;
  52 while (<$fh1>) {
  53     print;
  54 }
  55 close $fh1;
  56
  57 if (open my $fh2, '<', $filename) {
  58     while (<$fh2>) {
  59         print;
  60     }
  61     close $fh2;
  62 }
  63
  64 #-----------------------------------------------------------------------------
  65
  66 ## name basic failures
  67 ## failures 2
  68 ## cut
  69
  70 open my $fh1, '<', $filename or die;
  71 close $fh0;
  72 if (open my $fh2, '<', $filename) {
  73     while (<$fh2>) {
  74         print;
  75     }
  76 }
  77
  78 #-----------------------------------------------------------------------------
  79
  80 ## name lexical wrong name failure
  81 ## failures 2
  82 ## cut
  83
  84 open my $fh1, '<', $filename or die;
  85 close $fh2;
  86 open my $fh3, '<', $filename or die;
  87 $fh4->close;
  88
  89 #-----------------------------------------------------------------------------
  90
  91 ## name scope failure
  92 ## failures 1
  93 ## cut
  94
  95 {
  96     open my $fh1, '<', $filename;
  97 }
  98 close $fh1;
  99
 100 #-----------------------------------------------------------------------------
 101
 102 ## name glob scope failure
 103 ## failures 1
 104 ## cut
 105
 106 {
 107     open FH1, '<', $filename;
 108 }
 109 close FH1;
 110
 111 #-----------------------------------------------------------------------------
 112
 113 ## name glob filehandle
 114 ## failures 0
 115 ## cut
 116
 117 local (*FH1);
 118 open FH1, '<', $filename or die;
 119 close FH1;
 120
 121 #-----------------------------------------------------------------------------
 122
 123 ## name glob failure
 124 ## failures 2
 125 ## cut
 126
 127 local (*FH2);
 128 open FH2, '<', $filename or die;
 129 open *FH3, '<', $filename or die;
 130
 131 #-----------------------------------------------------------------------------
 132
 133 ## name glob wrong name failure
 134 ## failures 1
 135 ## cut
 136
 137 local (*FH1);
 138 open FH1, '<', $filename or die;
 139 close FH2;
 140
 141 #-----------------------------------------------------------------------------
 142
 143 ## name we do not flag non-uppercase globs -- maybe it is a sub call
 144 ## failures 0
 145 ## cut
 146
 147 local (*fh1);
 148 open fh1, '<', $filename or die;
 149
 150 #-----------------------------------------------------------------------------
 151
 152 ## name fail blocks
 153 ## failures 2
 154 ## cut
 155
 156 my $foo;
 157 open {$foo}, '<', $filename or die;
 158
 159 open {*BAR}, '<', $filename or die;
 160
 161 #-----------------------------------------------------------------------------
 162
 163 ## name allow std handles
 164 ## failures 0
 165 ## cut
 166
 167 open STDIN, '<', $filename or die;
 168 open STDOUT, '>', $filename or die;
 169 open STDERR, '>', $filename or die;
 170
 171 #-----------------------------------------------------------------------------
 172
 173 ## name allow std globs in blocks
 174 ## failures 0
 175 ## cut
 176
 177 open {*STDIN}, '<', $filename or die;
 178 open {*STDOUT}, '>', $filename or die;
 179 open {*STDERR}, '>', $filename or die;
 180
 181 #-----------------------------------------------------------------------------
 182
 183 ## name config - pass at default
 184 ## failures 0
 185 ## cut
 186
 187 open my $fh1, '<', $filename;
 188 # 1
 189 # 2
 190 # 3
 191 # 4
 192 # 5
 193 # 6
 194 # 7
 195 # 8
 196 close $fh1;
 197
 198 #-----------------------------------------------------------------------------
 199
 200 ## name config - fail at one after default
 201 ## failures 1
 202 ## cut
 203
 204 open my $fh1, '<', $filename;
 205 # 1
 206 # 2
 207 # 3
 208 # 4
 209 # 5
 210 # 6
 211 # 7
 212 # 8
 213 # 9
 214 close $fh1;
 215
 216 #-----------------------------------------------------------------------------
 217
 218 ## name config - set lines to 2
 219 ## failures 1
 220 ## parms {lines => '2'}
 221 ## cut
 222
 223 open my $fh1, '<', $filename;
 224 # 1
 225 close $fh1;
 226
 227 open my $fh2, '<', $filename;
 228 # 1
 229 # 2
 230 close $fh2;
 231
 232 #-----------------------------------------------------------------------------
 233
 234 ## name nested sub
 235 ## failures 1
 236 ## cut
 237
 238 open my $fh1, '<', $filename;
 239 sub not_a_recommended_idiom {
 240     close $fh1;
 241 }
 242
 243 #-----------------------------------------------------------------------------
 244
 245 ## name opener sub
 246 ## failures 0
 247 ## cut
 248
 249 sub my_open {
 250     my ($filename) = @_;
 251     open my $fh1, '<', $filename or return;
 252     return $fh1;
 253 }
 254
 255 #-----------------------------------------------------------------------------
 256
 257 ## name long opener sub failure
 258 ## failures 1
 259 ## cut
 260
 261 sub my_open {
 262     my ($filename) = @_;
 263     open my $fh1, '<', $filename or return;
 264     # 1
 265     # 2
 266     # 3
 267     # 4
 268     # 5
 269     # 6
 270     # 7
 271     # 8
 272     # 9
 273     return $fh1;
 274 }
 275
 276 #-----------------------------------------------------------------------------
 277
 278 ## name opener sub failure
 279 ## failures 1
 280 ## cut
 281
 282 sub my_open {
 283     my ($filename) = @_;
 284     open my $fh1, '<', $filename or return;
 285     return $fh2;
 286 }
 287
 288 #-----------------------------------------------------------------------------
 289
 290 ## name unusual lexical syntax
 291 ## failures 1
 292 ## TODO we do not recognize parenthesized lexical declarations
 293 ## cut
 294
 295 open my ($fh1), '<', $filename;
 296
 297 #-----------------------------------------------------------------------------
 298
 299 ## name code coverage - unsupported open() calls
 300 ## failures 0
 301 ## cut
 302
 303 $self->open($door);
 304 open($fh); # erroneous call
 305 open(get_fh(), '<', $filename); # first arg returns a filehandle -- bad form
 306 open(1 + 1, '<', $filename); # nonsense
 307
 308 #-----------------------------------------------------------------------------
 309
 310 ## name code coverage - glob topic for method call
 311 ## failures 1
 312 ## cut
 313
 314 open FH1, '<', $filename;
 315 FH1->close; # invalid code
 316
 317 #-----------------------------------------------------------------------------
 318
 319 ## name code coverage - close is not a function or method call
 320 ## failures 1
 321 ## cut
 322
 323 open my $fh, '<', $filename;
 324 $hash->{close};
 325
 326 #-----------------------------------------------------------------------------
 327
 328 ## name code coverage - FH is not a glob or scalar
 329 ## failures 0
 330 ## cut
 331
 332 open @foo, '<', $filename; # nonsense
 333 open @$foo, '<', $filename; # nonsense
 334 open my @bar, '<', $filename; # nonsense
 335
 336 #-----------------------------------------------------------------------------
 337
 338 # Local Variables:
 339 #   mode: cperl
 340 #   cperl-indent-level: 4
 341 #   fill-column: 78
 342 #   indent-tabs-mode: nil
 343 #   c-indentation-style: bsd
 344 # End:
 345 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :