From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

## name Unspectacular die
## failures 3
## cut
die 'A horrible death' if $condtion;
if ($condition) {
die 'A horrible death';
}
open my $fh, '<', $path or
die "Can't open file $path";
#-----------------------------------------------------------------------------
## name Unspectacular warn
## failures 3
## cut
warn 'A horrible warning' if $condtion;
if ($condition) {
warn 'A horrible warning';
}
open my $fh, '<', $path or
warn "Can't open file $path";
#-----------------------------------------------------------------------------
## name Carping
## failures 0
## cut
carp 'A horrible death' if $condtion;
if ($condition) {
carp 'A horrible death';
}
open my $fh, '<', $path or
carp "Can't open file $path";
#-----------------------------------------------------------------------------
## name No croaking
## failures 1
## cut
die 'A horrible death';
#-----------------------------------------------------------------------------
## name Complain about cases without arguments.
## failures 2
## cut
die;
die
#-----------------------------------------------------------------------------
## name Complain about cases with empty list arguments.
## failures 2
## cut
die ( );
die ( )
#-----------------------------------------------------------------------------
## name Complain about cases with non-string arguments.
## failures 7
## cut
die $error;
die @errors;
die %errors_by_id;
die $errors[0];
die $errors_by_id{"Cheese fondue overflow"};
die $marvin_gaye->whats_goin_on();
die $george_washington->cross("Delaware River\n");
#-----------------------------------------------------------------------------
## name Don't complain about obvious uses of references because they're likely being used as exception objects.
## TODO not yet implemented
## failures 0
## cut
die \$frobnication_exception;
die \@accumulated_warnings;
die \%problem_data;
die
[
'process.html: missing standard section separator comments',
'green.css: uses non-standard font "Broken 15"',
'cat.jpg: missing copyright information in Exif metadata',
];
die
{
message => 'Found duplicate entries',
file => $current_file,
parser => $self,
occurrences => $occurrences,
duplicated => $entry_content,
};
die Blrfl::Exception->new('Too many croutons', $salad);
#-----------------------------------------------------------------------------
## name Don't complain if message ends with "\n" in double quotes.
## failures 0
## cut
die "A horrible death\n" ;
die "A horrible death\n" # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Don't complain if message ends with literal "\n" (RT #25046)
## failures 0
## cut
die "A horrible death
" ;
die 'A horrible death
' ;
die q{A horrible death
} ;
die qq{A horrible death
} ;
#-----------------------------------------------------------------------------
## name Don't complain if message is a heredoc, which must end in "\n"
## failures 0
## cut
die <<'eod' ;
A horrible death
eod
die <<'eod' # last statement doesn't need a terminator
A horrible death
eod
#-----------------------------------------------------------------------------
## name Complain if message ends with "\n" in single quotes.
## failures 2
## cut
die 'A horrible death\n' ;
die 'A horrible death\n' # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Don't complain if message ends with "\n" in interpolated quotelike operator.
## failures 0
## cut
die qq{A horrible death\n} ;
die qq#A horrible death\n# ;
die qq/A horrible death\n/ # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Complain if message ends with "\n" in non-interpolated quotelike operator.
## failures 3
## cut
die q{A horrible death\n} ;
die q#A horrible death\n# ;
die q/A horrible death\n/ # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Don't complain if message is a list with a last element that ends with "\n"
## failures 0
## cut
die q{Don't }, $die, " a horrible death\n" ;
die qq{Don't }, $die, qq/ a horrible death\n/ ;
die q{Don't }, $die, " a horrible death\n" , ;
die q{Don't }, $die, " a horrible death\n" , # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Don't complain if message is a parenthesised list with a last element that ends with "\n"
## failures 0
## cut
die ( q{Don't }, $die, " a horrible death\n" ) ;
die ( qq{Don't }, $die, qq/ a horrible death\n/ ) ;
die ( qq{Don't }, $die, qq/ a horrible death\n/ ) , ;
die ( q{Don't }, $die, " a horrible death\n" , ) # last statement doesn't need a terminator
#-----------------------------------------------------------------------------
## name Don't complain if message is a list with "sub" lists with a last (flattened list) element that ends with "\n"
## failures 0
## cut
# all these tests are necessary (different PPI trees)
# one element in a sub list
die q{Don't } , ( $die ) , " a horrible death\n" ;
die q{Don't } , $die , ( " a horrible death\n" ) ;
# sub list and a bare element
die q{Don't } , ( $die , " a horrible death\n" ) ;
# two sub lists
die q{Don't } , ( $die ) , ( " a horrible death\n" ) ;
# sub sub lists
die ( ( q{Don't } ) , $die , " a horrible death\n" ) ;
die ( q{Don't } , $die , ( " a horrible death\n" ) ) ;
die ( q{Don't } , ( $die , ( " a horrible death\n" ) ) ) ;
die ( ( q{Don't } , ( $die , ( " a horrible death\n" ) ) ) ) ;
# play with extra commas
die ( ( q{Don't } , ( $die , ( " a horrible death\n" , ) , ) , ) , ) , ;
die ( ( q{Don't } , ( $die , ( " a horrible death\n" , ) , ) , ) , ) ,
#-----------------------------------------------------------------------------
## name Complain if message is a list with "sub" lists with a last (flattened list) element that doesn't end with "\n"
## failures 10
## cut
# all these tests are necessary: make sure that the policy knows when to
# stop looking.
# one element in a sub list
die q{Don't } , ( $die ) , @a_horrible_death ;
die q{Don't } , $die , ( @a_horrible_death ) ;
# sub list and a bare element
die q{Don't } , ( $die , @a_horrible_death ) ;
# two sub lists
die q{Don't } , ( $die ) , ( @a_horrible_death ) ;
# sub sub lists
die ( ( q{Don't } ) , $die , @a_horrible_death ) ;
die ( q{Don't } , $die , ( @a_horrible_death ) ) ;
die ( q{Don't } , ( $die , ( @a_horrible_death ) ) ) ;
die ( ( q{Don't } , ( $die , ( @a_horrible_death ) ) ) ) ;
# play with extra commas
die ( ( q{Don't } , ( $die , ( @a_horrible_death , ) , ) , ) , ) , ;
die ( ( q{Don't } , ( $die , ( @a_horrible_death , ) , ) , ) , ) ,
#-----------------------------------------------------------------------------
## name Don't complain if message is a concatenation with a last element that ends with "\n"
## failures 0
## cut
die q{Don't } . $die . " a horrible death\n" ;
die ( q{Don't } . $die . " a horrible death\n" ) ;
##-----------------------------------------------------------------------------
## name Complain if message has a last element that ends with "\n" but has an operation in front
## failures 2
## cut
die q{Don't } . $die . length " a horrible death\n" ;
die ( q{Don't } . $die . length " a horrible death\n" ) ;
#-----------------------------------------------------------------------------
## name Don't complain if followed by postfix operator and otherwise valid.
## failures 0
## cut
die "A horrible death\n" if $self->is_a_bad_guy();
die "A horrible death\n" unless $self->rescued_from_the_sinking_ship();
die "A horrible death\n" while $deep_sense_of_guilt;
die "A horrible death\n" until $clear_conscience;
die "A horrible death\n" for @your_crimes;
die "A horrible death\n" foreach @{ $songs_sung_off_key };
die 'A horrible ', "death\n" if $self->is_a_bad_guy();
die 'A horrible ', "death\n" unless $self->rescued_from_the_sinking_ship();
die 'A horrible ', "death\n" while $deep_sense_of_guilt;
die 'A horrible ', "death\n" until $clear_conscience;
die 'A horrible ', "death\n" for @your_crimes;
die 'A horrible ', "death\n" foreach @{ $songs_sung_off_key };
die ( 'A horrible ', "death\n" ) if $self->is_a_bad_guy();
die ( 'A horrible ', "death\n" ) unless $self->rescued_from_the_sinking_ship();
die ( 'A horrible ', "death\n" ) while $deep_sense_of_guilt;
die ( 'A horrible ', "death\n" ) until $clear_conscience;
die ( 'A horrible ', "death\n" ) for @your_crimes;
die ( 'A horrible ', "death\n" ) foreach @{ $songs_sung_off_key };
die ( 'A horrible ' . "death\n" ) if $self->is_a_bad_guy();
die ( 'A horrible ' . "death\n" ) unless $self->rescued_from_the_sinking_ship();
die ( 'A horrible ' . "death\n" ) while $deep_sense_of_guilt;
die ( 'A horrible ' . "death\n" ) until $clear_conscience;
die ( 'A horrible ' . "death\n" ) for @your_crimes;
die ( 'A horrible ' . "death\n" ) foreach @{ $songs_sung_off_key };
#-----------------------------------------------------------------------------
## name Complain if followed by postfix operator with "\n" ending last operand and otherwise invalid.
## failures 24
## cut
die "A horrible death" if "Matagami\n";
die "A horrible death" unless "Enniscorthy\n";
die "A horrible death" while "Htargcm\n";
die "A horrible death" until "Akhalataki\n";
die "A horrible death" for "Fleac\n";
die "A horrible death" foreach "Uist\n";
die 'A horrible ', "death" if "Matagami\n";
die 'A horrible ', "death" unless "Enniscorthy\n";
die 'A horrible ', "death" while "Htargcm\n";
die 'A horrible ', "death" until "Akhalataki\n";
die 'A horrible ', "death" for "Fleac\n";
die 'A horrible ', "death" foreach "Uist\n";
die ( 'A horrible ', "death" ) if "Matagami\n";
die ( 'A horrible ', "death" ) unless "Enniscorthy\n";
die ( 'A horrible ', "death" ) while "Htargcm\n";
die ( 'A horrible ', "death" ) until "Akhalataki\n";
die ( 'A horrible ', "death" ) for "Fleac\n";
die ( 'A horrible ', "death" ) foreach "Uist\n";
die ( 'A horrible ' . "death" ) if "Matagami\n";
die ( 'A horrible ' . "death" ) unless "Enniscorthy\n";
die ( 'A horrible ' . "death" ) while "Htargcm\n";
die ( 'A horrible ' . "death" ) until "Akhalataki\n";
die ( 'A horrible ' . "death" ) for "Fleac\n";
die ( 'A horrible ' . "death" ) foreach "Uist\n";
#-----------------------------------------------------------------------------
## name Complain if config doesn't allow newlines.
## failures 1
## parms { allow_messages_ending_with_newlines => 0 }
## cut
die "A horrible death\n" ;
#-----------------------------------------------------------------------------
## name Complain if in main:: and option not set (RT #56619)
## failures 1
## cut
package main;
die "A horrible death";
#-----------------------------------------------------------------------------
## name Don't complain if in main:: and option set (RT #56619)
## failures 0
## parms { allow_in_main_unless_in_subroutine => 1 }
## cut
package main;
die "A horrible death";
#-----------------------------------------------------------------------------
## name Don't complain if implicitly in main:: and option set (RT #56619)
## failures 0
## parms { allow_in_main_unless_in_subroutine => 1 }
## cut
die "A horrible death";
#-----------------------------------------------------------------------------
## name Complain if in main:: but in subroutine (RT #56619)
## parms { allow_in_main_unless_in_subroutine => 1 }
## failures 1
## cut
sub foo {
die "Goodbye, cruel world!";
}
#-----------------------------------------------------------------------------
## name Complain if in main:: but in anonymous subroutine (RT #56619)
## parms { allow_in_main_unless_in_subroutine => 1 }
## failures 1
## cut
my $foo = sub {
die "Goodbye, cruel world!";
};
#-----------------------------------------------------------------------------
##############################################################################
# $Date: 2010-04-21 14:11:17 -0500 (Wed, 21 Apr 2010) $
# $Author: wyant $
# $Revision: 3801 $
##############################################################################
# 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 :