Test-Warn

 view release on metacpan or  search on metacpan

t/warning_is.t  view on Meta::CPAN

);

use Test::Builder::Tester tests  => TESTS() * SUBTESTS_PER_TESTS;
use Test::Warn;
#use Test::Exception;

Test::Builder::Tester::color 'on';

use constant WARN_LINE => line_num +2; 
sub _make_warn {
    warn $_ for grep $_, split m:\|:, (shift() || "");
}

use constant CARP_LINE => line_num +2;
sub _make_carp {
    carp $_ for grep $_, split m:\|:, (shift() || "");
}

use constant CARP_LEVELS => (0 .. 2);
sub _create_exp_warning {
    my ($carplevel, $warning) = @_;
    return $warning               if $carplevel == 0;
    return {carped => $warning}   if $carplevel == 1;
    return {carped => [$warning]} if $carplevel == 2;
}

t/warning_is.t  view on Meta::CPAN

sub test_warning_is {
    my ($ok, $msg, $exp_warning, $testname) = @_;
    for my $carp (CARP_LEVELS) {
        *_found_msg         = $carp ? *_found_carp_msg : *_found_warn_msg;
        *_exp_msg           = $carp ? *_exp_carp_msg   : *_exp_warn_msg;
        *_make_warn_or_carp = $carp ? *_make_carp      : *_make_warn;
        for my $t (undef, $testname) {
            test_out "$ok 1" . ($t ? " - $t" : "");
            if ($ok =~ /not/) {
                test_fail +4;
                test_diag  _found_msg($_) for ($msg ? (split m-\|-, $msg) : $msg);
                test_diag  _exp_msg($exp_warning);
            }
            warning_is {_make_warn_or_carp($msg)} _create_exp_warning($carp, $exp_warning), $t;
            test_test  "$testname (with" . ($_ ? "" : "out") . " a testname)";
        }
    }
}

sub _found_warn_msg {
    defined($_[0]) 

t/warning_like.t  view on Meta::CPAN

use constant SUBTESTS_PER_TESTS  => 12;

use Test::Builder::Tester tests  => TESTS() * SUBTESTS_PER_TESTS;
#use Test::Exception;
use Test::Warn;

Test::Builder::Tester::color 'on';

use constant WARN_LINE => line_num +2; 
sub _make_warn {
    warn $_ for grep $_, split m:\|:, (shift() || "");
}

use constant CARP_LINE => line_num +2; 
sub _make_carp {
    carp $_ for grep $_, split m:\|:, (shift() || "");
}

use constant CARP_LEVELS => (0 .. 2);
sub _create_exp_warning {
    my ($carplevel, $warning) = @_;
    return $warning               if $carplevel == 0;
    return {carped => $warning}   if $carplevel == 1;
    return {carped => [$warning]} if $carplevel == 2;
}

t/warning_like.t  view on Meta::CPAN

        *_found_msg         = $carp ? *_found_carp_msg : *_found_warn_msg;
        *_exp_msg           = $carp ? *_exp_carp_msg   : *_exp_warn_msg;
        *_make_warn_or_carp = $carp ? *_make_carp      : *_make_warn;
        for my $t (undef, $testname) {
            my @regexes = $exp_warning ? (qr/$exp_warning/, "/$exp_warning/")
                                       : (undef, undef);  # simpler to count the tests
            for my $regex (@regexes) {
                test_out "$ok 1" . ($t ? " - $t" : "");
                if ($ok =~ /not/) {
                    test_fail +4;
                    test_diag  _found_msg($_) for ($msg ? (split m-\|-, $msg) : $msg);
                    test_diag  _exp_msg($regex);
                }
                warning_like {_make_warn_or_carp($msg)} _create_exp_warning($carp, $regex), $t;
                test_test  "$testname (with" . ($_ ? "" : "out") . " a testname)";
            }
        }
    }
}

sub _found_warn_msg {