## 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!";
};

#-----------------------------------------------------------------------------

##############################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/distributions/Perl-Critic/t/ErrorHandling/RequireCarping.run $
#     $Date: 2010-04-21 12:11:17 -0700 (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 :