package tests::TestTestCaseTest; use strict; use base qw/Test::Unit::TestCase/; use Lire::Test::TestCase; use Lire::Config; use Lire::PluginManager; use POSIX qw/setlocale LC_MESSAGES/; sub test_set_up { my $self = $_[0]; my $test = new Lire::Test::TestCase(); my $or_cfg = Lire::Config->instance(); my $or_locale = setlocale( LC_MESSAGES ); $test->set_up(); my $cfg = $test->{'cfg'}; $self->assert_str_equals( $cfg, Lire::Config->instance() ); $self->assert_str_equals( $or_locale, $test->{'_old_lc_messages'} ); $self->assert_str_equals( 'C', setlocale( LC_MESSAGES ) ); $test->tear_down(); $self->assert_str_equals( $or_cfg, Lire::Config->instance() ); $self->assert_str_equals( $test->{'_old_lc_messages'}, setlocale( LC_MESSAGES ) ); } sub test_set_up_plugin_mgr { my $self = $_[0]; my $original = $Lire::PluginManager::instance; my $test = new Lire::Test::TestCase(); $self->assert_null( $test->{'_old_plugin_mgr'}, '_old_plugin_mgr' ); $test->set_up_plugin_mgr(); $self->assert_str_equals( $original, $test->{'_old_plugin_mgr'} ); $self->assert_str_not_equals( $original, $Lire::PluginManager::instance ); my $new = $Lire::PluginManager::instance; $test->set_up_plugin_mgr(); $self->assert_str_equals( $original, $test->{'_old_plugin_mgr'} ); $self->assert_str_equals( $new, $Lire::PluginManager::instance ); $test->_tear_down_plugin_mgr(); $self->assert_str_equals( $original, $Lire::PluginManager::instance ); $self->assert_null( $test->{'_old_plugin_mgr'}, '_old_plugin_mgr' ); $test->_tear_down_plugin_mgr(); $self->assert_str_equals( $original, $Lire::PluginManager::instance ); } sub test_set_up_tz { my $self = $_[0]; my $mar11_2004_noon_in_EST = 1079024400; my $test = new Lire::Test::TestCase(); local $ENV{'TZ'} = 'EST'; $test->set_up_tz( 'CEST' ); $self->assert_str_equals( 'EST', $test->{'_old_tz'} ); $self->assert_str_equals( 'CEST', $ENV{'TZ'} ); my @time = localtime( $mar11_2004_noon_in_EST ); $self->assert_num_equals( 17, $time[2] ); $test->_tear_down_tz(); $self->assert_str_equals( 'EST', $ENV{'TZ'} ); @time = localtime( $mar11_2004_noon_in_EST ); $self->assert_num_equals( 12, $time[2] ); $self->assert_null( $test->{'_old_tz'}, '_old_tz should be undef' ); } sub test_assert_died { my $self = $_[0]; my $test = new Lire::Test::TestCase(); eval { $test->assert_died() }; my $msg = $@; my $success = $msg =~ /missing 'test' parameter/; my $our_point_view = $msg =~ m!tests/TestTestCaseTest.pm:\d+!; $self->assert( $success, "expected died with message 'missing 'test' parameter', got '$msg'" ); $self->assert( $our_point_view, "errror should be reported from our point of view, got '$msg'" ); eval { $test->assert_died( sub {} ) }; $success = $@ =~ /missing 'regex' parameter/; $self->assert( $success, "expected died with message 'missing 'regex' parameter', got '$@'" ); eval { $test->assert_died( "", qr// ) }; $success = $@ =~ /'test' parameter.*CODE/; $self->assert( $success, "expected died with message ''test' parameter.*CODE', got '$@'" ); eval { $test->assert_died( sub {}, "" ) }; $success = $@ =~ /'regex' parameter.*Regexp/; $self->assert( $success, "expected died with message ''regex' parameter.*Regexp', got '$@'" ); eval { $test->assert_died( sub {}, qr// ) }; $success = $@ =~ /expected test to die/; $self->assert( $success, "expected died with message 'expected test to die', got '$@'" ); eval { $test->assert_died( sub { die "wrong message"}, qr/good message/ ) }; $success = $@ =~ /expected die message to match/; $our_point_view = $msg =~ m!tests/TestTestCaseTest.pm:\d+!; $self->assert( $success, "expected die message with message 'expected die message to match', got '$@'" ); $self->assert( $our_point_view, "errror should be reported from our point of view, got '$msg'" ); eval { $test->assert_died( sub { die "wrong message"}, qr/good message/, "custom message" ) }; $success = $@ =~ /custom message/; $self->assert( $success, "expected die message with message 'custom message', got '$@'" ); eval { $test->assert_died( sub { die "good message"}, qr/good message/ ) }; $self->assert( ! $@, "test shouldn't have failed: '$@'" ); } sub test_lire_default_config_spec { my $self = $_[0]; my $test = new Lire::Test::TestCase(); my $spec = $test->lire_default_config_spec(); $self->assert_not_null( $spec, "returned undef" ); $self->assert( UNIVERSAL::isa( $spec, 'Lire::Config::ConfigSpec' ), 'not a Lire::Config::ConfigSpec' ); my @toplevels = map { $_->name() } $spec->components(); $self->assert( scalar grep { $_ eq 'import_jobs' } @toplevels, 'expected to find an "import_jobs" parameter' ); } sub test_assert_isa { my $self = $_[0]; my $test = new Lire::Test::TestCase(); $test->assert_died( sub { $test->assert_isa() }, qr/missing 'class' parameter/ ); $test->assert_died( sub { $test->assert_isa( 'HASH' ) }, qr/missing 'instance' parameter/ ); $test->assert_died( sub { $test->assert_isa( 'HASH', undef ) }, qr/expected a 'HASH' instance, got undef/ ); $test->assert_died( sub { $test->assert_isa( 'HASH', undef, 'wawa') }, qr/wawa/ ); $test->assert_died( sub { $test->assert_isa( 'aClass', bless( {}, 'test') ) }, qr/expected a 'aClass' instance, got a 'test' instance/); $test->assert_died( sub { $test->assert_isa( 'HASH', 'test' ) }, qr/expected a 'HASH' instance, got unblessed 'test'/); $test->assert_isa( 'test', bless {}, 'test' ); } 1;