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()); 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()); 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;