The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

##############################################################################
# $Date: 2009-03-07 09:14:51 -0600 (Sat, 07 Mar 2009) $
# $Author: clonezone $
# $Revision: 3231 $
##############################################################################
## name open .. close
## failures 0
## cut
open my $fh1, '<', $filename or die;
close $fh1;
open my $fh2, '<', $filename or die;
close $fh2;
if (open my $fh3, '<', $filename) {
close $fh3;
}
my $fh4;
open $fh4, '<', $filename or die;
close $fh4;
#-----------------------------------------------------------------------------
## name OO
## failures 0
## cut
open my $fh1, '<', $filename or die;
$fh1->close;
#-----------------------------------------------------------------------------
## name else
## failures 0
## cut
if (!open my $fh3, '<', $filename) {
croak;
} else {
close $fh3;
}
#-----------------------------------------------------------------------------
## name while .. print
## failures 0
## cut
open my $fh1, '<', $filename or die;
while (<$fh1>) {
print;
}
close $fh1;
if (open my $fh2, '<', $filename) {
while (<$fh2>) {
print;
}
close $fh2;
}
#-----------------------------------------------------------------------------
## name basic failures
## failures 2
## cut
open my $fh1, '<', $filename or die;
close $fh0;
if (open my $fh2, '<', $filename) {
while (<$fh2>) {
print;
}
}
#-----------------------------------------------------------------------------
## name lexical wrong name failure
## failures 2
## cut
open my $fh1, '<', $filename or die;
close $fh2;
open my $fh3, '<', $filename or die;
$fh4->close;
#-----------------------------------------------------------------------------
## name scope failure
## failures 1
## cut
{
open my $fh1, '<', $filename;
}
close $fh1;
#-----------------------------------------------------------------------------
## name glob scope failure
## failures 1
## cut
{
open FH1, '<', $filename;
}
close FH1;
#-----------------------------------------------------------------------------
## name glob filehandle
## failures 0
## cut
local (*FH1);
open FH1, '<', $filename or die;
close FH1;
#-----------------------------------------------------------------------------
## name glob failure
## failures 2
## cut
local (*FH2);
open FH2, '<', $filename or die;
open *FH3, '<', $filename or die;
#-----------------------------------------------------------------------------
## name glob wrong name failure
## failures 1
## cut
local (*FH1);
open FH1, '<', $filename or die;
close FH2;
#-----------------------------------------------------------------------------
## name we do not flag non-uppercase globs -- maybe it is a sub call
## failures 0
## cut
local (*fh1);
open fh1, '<', $filename or die;
#-----------------------------------------------------------------------------
## name fail blocks
## failures 2
## cut
my $foo;
open {$foo}, '<', $filename or die;
open {*BAR}, '<', $filename or die;
#-----------------------------------------------------------------------------
## name allow std handles
## failures 0
## cut
open STDIN, '<', $filename or die;
open STDOUT, '>', $filename or die;
open STDERR, '>', $filename or die;
#-----------------------------------------------------------------------------
## name allow std globs in blocks
## failures 0
## cut
open {*STDIN}, '<', $filename or die;
open {*STDOUT}, '>', $filename or die;
open {*STDERR}, '>', $filename or die;
#-----------------------------------------------------------------------------
## name config - pass at default
## failures 0
## cut
open my $fh1, '<', $filename;
# 1
# 2
# 3
# 4
# 5
# 6
# 7
# 8
close $fh1;
#-----------------------------------------------------------------------------
## name config - fail at one after default
## failures 1
## cut
open my $fh1, '<', $filename;
# 1
# 2
# 3
# 4
# 5
# 6
# 7
# 8
# 9
close $fh1;
#-----------------------------------------------------------------------------
## name config - set lines to 2
## failures 1
## parms {lines => '2'}
## cut
open my $fh1, '<', $filename;
# 1
close $fh1;
open my $fh2, '<', $filename;
# 1
# 2
close $fh2;
#-----------------------------------------------------------------------------
## name nested sub
## failures 1
## cut
open my $fh1, '<', $filename;
sub not_a_recommended_idiom {
close $fh1;
}
#-----------------------------------------------------------------------------
## name opener sub
## failures 0
## cut
sub my_open {
my ($filename) = @_;
open my $fh1, '<', $filename or return;
return $fh1;
}
#-----------------------------------------------------------------------------
## name long opener sub failure
## failures 1
## cut
sub my_open {
my ($filename) = @_;
open my $fh1, '<', $filename or return;
# 1
# 2
# 3
# 4
# 5
# 6
# 7
# 8
# 9
return $fh1;
}
#-----------------------------------------------------------------------------
## name opener sub failure
## failures 1
## cut
sub my_open {
my ($filename) = @_;
open my $fh1, '<', $filename or return;
return $fh2;
}
#-----------------------------------------------------------------------------
## name unusual lexical syntax
## failures 1
## TODO we do not recognize parenthesized lexical declarations
## cut
open my ($fh1), '<', $filename;
#-----------------------------------------------------------------------------
## name code coverage - unsupported open() calls
## failures 0
## cut
$self->open($door);
open($fh); # erroneous call
open(get_fh(), '<', $filename); # first arg returns a filehandle -- bad form
open(1 + 1, '<', $filename); # nonsense
#-----------------------------------------------------------------------------
## name code coverage - glob topic for method call
## failures 1
## cut
open FH1, '<', $filename;
FH1->close; # invalid code
#-----------------------------------------------------------------------------
## name code coverage - close is not a function or method call
## failures 1
## cut
open my $fh, '<', $filename;
$hash->{close};
#-----------------------------------------------------------------------------
## name code coverage - FH is not a glob or scalar
## failures 0
## cut
open @foo, '<', $filename; # nonsense
open @$foo, '<', $filename; # nonsense
open my @bar, '<', $filename; # nonsense
#-----------------------------------------------------------------------------
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 78
# indent-tabs-mode: nil
# c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :