view release on metacpan or  search on metacpan

t/02_fatal.t  view on Meta::CPAN

##############################################################################
#     $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/criticism-1.02/t/02_fatal.t $
#    $Date: 2008-07-27 16:11:59 -0700 (Sun, 27 Jul 2008) $
#   $Author: thaljef $
# $Revision: 2622 $
##############################################################################

use strict;
use warnings;
use IO::String ();
use FindBin qw<$Bin>;
use File::Basename qw<basename>;
use File::Spec::Functions qw(catfile);
use English qw<-no_match_vars>;
use Test::More tests => 4;

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

# Find path to the directory with the test libs...
my $test_lib_basename = basename($PROGRAM_NAME, '.t');
my $test_lib_dirname = catfile( $Bin, "$test_lib_basename.lib");

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

test_with_criticism_fatal();
test_without_criticism_fatal();

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

sub test_with_criticism_fatal {
    my $module_path = "$test_lib_dirname/WithCriticismFatal.pm";
    my ($eval_error, $stderr_text) = require_file_and_catch_errors($module_path);

    like($eval_error, qr/compilation aborted/, 'Load fails when criticism is fatal');
    like($stderr_text, qr/Code before strictures/, 'criticism emitted warnings');
}

sub test_without_criticism_fatal {
    my $module_path = "$test_lib_dirname/WithoutCriticismFatal.pm";
    my ($eval_error, $stderr_text) = require_file_and_catch_errors($module_path);

    is($eval_error, q{}, 'Load succeeds when criticism is not fatal');
    like($stderr_text, qr/Code before strictures/, 'criticism emitted warnings');
}

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

sub require_file_and_catch_errors {
    my ($filename_to_require) = @_;
    my $stderr_text = q{};

    tie local *STDERR, 'IO::String';
    eval {require $filename_to_require};
    seek STDERR, 0, 0;  # Rewind fh to the beginning;
    $stderr_text = join "\n", <STDERR>;

    return ($EVAL_ERROR, $stderr_text);
}