The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Fatal::ExceptionTest;

use strict;
use warnings;

use base 'Test::Unit::TestCase';
use Test::Assert ':all';

use Fatal::Exception;

# non-CORE functions from own package
sub sub_test1 {
    return shift();
};

# non-CORE functions outer own package
{
    package Fatal::ExceptionTest::Package1;
    sub sub_test2 {
        return shift();
    };
};

# Should be before import test. Test::Unit can't sort subs' names.
sub test____sane {
    local *FOO;

    my $file = __FILE__;

    eval 'open FOO, "<", "$file"';
    die if $@;
    assert_matches(qr/^package/, scalar(<FOO>));

    eval 'close FOO';
    die if $@;

    eval 'opendir FOO, "."';
    die if $@;

    eval 'close FOO';
    die if $@;

    eval 'sub_test1 undef';
    die if $@;

    eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
    die if $@;
};

sub test_import {
    my $self = shift;

    local *FOO;

    # empty args
    Fatal::Exception->import();
    Fatal::Exception->unimport();

    # not enough args
    assert_raises( ['Exception::Argument'], sub {
        Fatal::Exception->import("open");
    } );

    # not such exception
    assert_raises( ['Exception::Fatal'], sub {
        Fatal::Exception->import("Exception::Fatal::import::NotFound", "open");
    } );

    # not such function
    assert_raises( ['Exception::Argument'], sub {
        Fatal::Exception->import("Exception::Fatal", "notsuchfunction$^T$$");
    } );

    # first wrapping
    Exception::Base->import("Exception::Fatal::import::Test1");
    Fatal::Exception->import(
        "Exception::Fatal::import::Test1", "open", "sub_test1",
        "Fatal::ExceptionTest::Package1::sub_test2", ":void", "opendir"
    );

    my $file = __FILE__;
    eval 'open FOO, "<", "$file"';
    die if $@;
    assert_matches(qr/^package/, scalar(<FOO>));

    close FOO;

    # : too many args
    assert_raises( ['Exception::Argument'], sub {
        eval 'open 1, 2, 3, 4, 5';
        die if $@;
    } );

    # : wrapped void=0
    assert_raises( ['Exception::Fatal::import::Test1'], sub {
        eval 'open FOO, "<", "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=0 with fatal error
    assert_raises( ['Exception::Fatal'], sub {
        eval 'open FOO, "badmode", "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in array context
    assert_raises( ['Exception::Fatal::import::Test1'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in array context with fatal error
    assert_raises( ['Exception::Fatal'], sub {
        eval 'opendir \1, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in scalar context
    eval 'my $ret1 = opendir FOO, "/doesnotexists$^T$$"';
    die if $@;

    # : wrapped void=1 in scalar context with fatal error
    assert_raises( qr/^Not a GLOB/, sub {
        eval 'my $ret1 = opendir \1, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped non-core, our package
    assert_raises( ['Exception::Fatal::import::Test1'], sub {
        eval 'sub_test1 undef';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test1'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );

    # re-wrapping, another exception
    Exception::Base->import("Exception::Fatal::import::Test2");
    Fatal::Exception->import(
        "Exception::Fatal::import::Test2", "open", "sub_test1",
        "Fatal::ExceptionTest::Package1::sub_test2", ":void", "opendir"
    );

    # : wrapped void=0
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'open FOO, "<", "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in array context
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in scalar context
    eval 'my $ret1 = opendir FOO, "/doesnotexists$^T$$"';
    die if $@;

    # : wrapped non-core, our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'sub_test1 undef';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );

    # re-wrapping, the same exception
    Fatal::Exception->import(
        "Exception::Fatal::import::Test2", "open", "sub_test1",
        "Fatal::ExceptionTest::Package1::sub_test2", ":void", "opendir"
    );

    # : wrapped void=0
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'open FOO, "<", "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in array context
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in scalar context
    eval 'my $ret1 = opendir FOO, "/doesnotexists$^T$$"';
    die if $@;

    # : wrapped non-core, our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'sub_test1 undef';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );

    # un-wrap some functions
    Fatal::Exception->unimport("open", "sub_test1", ":void", "notexists$^T$$");

    # : un-wrapped
    eval 'open FOO, "<", "/doesnotexists$^T$$"';
    die if $@;

    # : un-wrapped
    eval 'sub_test1 undef';
    die if $@;

    # : wrapped
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );

    # un-wrap un-wrapped
    eval 'Fatal::Exception->unimport("open", "sub_test1", ":void", "notexists$^T$$")';

    # : un-wrapped
    eval 'open FOO, "<", "/doesnotexists$^T$$"';
    die if $@;

    # : un-wrapped
    eval 'sub_test1 undef';
    die if $@;

    # : wrapped
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );

    # re-wrapping un-wrapped
    Fatal::Exception->import(
        "Exception::Fatal::import::Test2", "open", "sub_test1",
        "Fatal::ExceptionTest::Package1::sub_test2", ":void", "opendir"
    );

    # : wrapped void=0
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'open FOO, "<", "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in array context
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'opendir FOO, "/doesnotexists$^T$$"';
        die if $@;
    } );

    # : wrapped void=1 in scalar context
    eval 'my $ret1 = opendir FOO, "/doesnotexists$^T$$"';
    die if $@;

    # : wrapped non-core, our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'sub_test1 undef';
        die if $@;
    } );

    # : wrapped non-core, not our package
    assert_raises( ['Exception::Fatal::import::Test2'], sub {
        eval 'Fatal::ExceptionTest::Package1::sub_test2 undef';
        die if $@;
    } );
};

1;