Move common test methods to base class and mark them to be skipped in base class itself
This commit is contained in:
@@ -37,6 +37,9 @@ use File::Slurper 'read_lines';
|
|||||||
|
|
||||||
use base qw<Test::Class Class::Data::Inheritable>;
|
use base qw<Test::Class Class::Data::Inheritable>;
|
||||||
|
|
||||||
|
# Don't run the base tests defined in this class, run them in subclasses only
|
||||||
|
My::Test::Class->SKIP_CLASS( 1 );
|
||||||
|
|
||||||
INIT { Test::Class->runtests }
|
INIT { Test::Class->runtests }
|
||||||
|
|
||||||
my $EMPTY = q{};
|
my $EMPTY = q{};
|
||||||
@@ -79,6 +82,97 @@ sub teardown : Tests(teardown) {
|
|||||||
$sess->{Data} = {};
|
$sess->{Data} = {};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub constructor : Tests(8) {
|
||||||
|
my $test = shift;
|
||||||
|
my $class = $test->class;
|
||||||
|
|
||||||
|
can_ok $class, 'new';
|
||||||
|
isa_ok $test->{info}, $class, '... and the object it returns';
|
||||||
|
|
||||||
|
is(defined $test->{info}{init}, 1, 'MIBs initialized');
|
||||||
|
ok(
|
||||||
|
scalar keys %{$test->{info}{mibs}},
|
||||||
|
'MIBs subclass data structure initialized'
|
||||||
|
);
|
||||||
|
ok(
|
||||||
|
scalar keys %{$test->{info}{globals}},
|
||||||
|
'Globals subclass data structure initialized'
|
||||||
|
);
|
||||||
|
ok(
|
||||||
|
scalar keys %{$test->{info}{funcs}},
|
||||||
|
'Funcs subclass data structure initialized'
|
||||||
|
);
|
||||||
|
ok(
|
||||||
|
scalar keys %{$test->{info}{munge}},
|
||||||
|
'Munge subclass data structure initialized'
|
||||||
|
);
|
||||||
|
is_deeply($test->{info}{store}, {}, 'Store initialized');
|
||||||
|
}
|
||||||
|
|
||||||
|
sub globals : Tests(2) {
|
||||||
|
my $test = shift;
|
||||||
|
|
||||||
|
can_ok($test->{info}, 'globals');
|
||||||
|
|
||||||
|
subtest 'Globals can() subtest' => sub {
|
||||||
|
|
||||||
|
my $test_globals = $test->{info}->globals;
|
||||||
|
foreach my $key (keys %$test_globals) {
|
||||||
|
can_ok($test->{info}, $key);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub funcs : Tests(2) {
|
||||||
|
my $test = shift;
|
||||||
|
|
||||||
|
can_ok($test->{info}, 'funcs');
|
||||||
|
|
||||||
|
subtest 'Funcs can() subtest' => sub {
|
||||||
|
|
||||||
|
my $test_funcs = $test->{info}->funcs;
|
||||||
|
foreach my $key (keys %$test_funcs) {
|
||||||
|
can_ok($test->{info}, $key);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub mibs : Tests(2) {
|
||||||
|
my $test = shift;
|
||||||
|
|
||||||
|
can_ok($test->{info}, 'mibs');
|
||||||
|
|
||||||
|
subtest 'MIBs loaded subtest' => sub {
|
||||||
|
|
||||||
|
my $mibs = $test->{info}->mibs();
|
||||||
|
|
||||||
|
foreach my $key (keys %$mibs) {
|
||||||
|
my $qual_name = "$key" . '::' . "$mibs->{$key}";
|
||||||
|
ok(defined $SNMP::MIB{$mibs->{$key}}, "$qual_name defined");
|
||||||
|
like(SNMP::translateObj($qual_name),
|
||||||
|
qr/^(\.\d+)+$/, "$qual_name translates to a OID");
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub munge : Tests(2) {
|
||||||
|
my $test = shift;
|
||||||
|
|
||||||
|
can_ok($test->{info}, 'munge');
|
||||||
|
|
||||||
|
subtest 'Munges subtest' => sub {
|
||||||
|
|
||||||
|
my $test_munges = $test->{info}->munge();
|
||||||
|
foreach my $key (keys %$test_munges) {
|
||||||
|
isa_ok($test_munges->{$key}, 'CODE', "$key munge");
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Utility methods / functions
|
||||||
|
#
|
||||||
|
|
||||||
sub create_mock_session {
|
sub create_mock_session {
|
||||||
|
|
||||||
my $home = dir($ENV{HOME}, 'netdisco-mibs');
|
my $home = dir($ENV{HOME}, 'netdisco-mibs');
|
||||||
|
|||||||
@@ -33,32 +33,9 @@ use Test::Class::Most parent => 'My::Test::Class';
|
|||||||
|
|
||||||
use SNMP::Info;
|
use SNMP::Info;
|
||||||
|
|
||||||
sub constructor : Tests(11) {
|
sub constructor : Tests(+3) {
|
||||||
my $test = shift;
|
my $test = shift;
|
||||||
my $class = $test->class;
|
$test->SUPER::constructor;
|
||||||
my $sess = $test->mock_session;
|
|
||||||
|
|
||||||
can_ok $class, 'new';
|
|
||||||
isa_ok $test->{info}, $class, '... and the object it returns';
|
|
||||||
|
|
||||||
is(defined $test->{info}{init}, 1, 'MIBs initialized');
|
|
||||||
ok(
|
|
||||||
scalar keys %{$test->{info}{mibs}},
|
|
||||||
'MIBs subclass data structure initialized'
|
|
||||||
);
|
|
||||||
ok(
|
|
||||||
scalar keys %{$test->{info}{globals}},
|
|
||||||
'Globals subclass data structure initialized'
|
|
||||||
);
|
|
||||||
ok(
|
|
||||||
scalar keys %{$test->{info}{funcs}},
|
|
||||||
'Funcs subclass data structure initialized'
|
|
||||||
);
|
|
||||||
ok(
|
|
||||||
scalar keys %{$test->{info}{munge}},
|
|
||||||
'Munge subclass data structure initialized'
|
|
||||||
);
|
|
||||||
is_deeply($test->{info}{store}, {}, 'Store initialized');
|
|
||||||
|
|
||||||
is($test->{info}{snmp_comm}, 'public', 'SNMP comm arg saved');
|
is($test->{info}{snmp_comm}, 'public', 'SNMP comm arg saved');
|
||||||
is($test->{info}{snmp_ver}, 2, 'SNMP version arg saved');
|
is($test->{info}{snmp_ver}, 2, 'SNMP version arg saved');
|
||||||
@@ -900,66 +877,6 @@ sub error_throw : Tests(7) {
|
|||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub funcs : Tests(2) {
|
|
||||||
my $test = shift;
|
|
||||||
|
|
||||||
can_ok($test->{info}, 'funcs');
|
|
||||||
|
|
||||||
subtest 'Funcs can() subtest' => sub {
|
|
||||||
|
|
||||||
my $test_funcs = $test->{info}->funcs;
|
|
||||||
foreach my $key (keys %$test_funcs) {
|
|
||||||
can_ok($test->{info}, $key);
|
|
||||||
}
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub globals : Tests(2) {
|
|
||||||
my $test = shift;
|
|
||||||
|
|
||||||
can_ok($test->{info}, 'globals');
|
|
||||||
|
|
||||||
subtest 'Globals can() subtest' => sub {
|
|
||||||
|
|
||||||
my $test_globals = $test->{info}->globals;
|
|
||||||
foreach my $key (keys %$test_globals) {
|
|
||||||
can_ok($test->{info}, $key);
|
|
||||||
}
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub mibs : Tests(2) {
|
|
||||||
my $test = shift;
|
|
||||||
|
|
||||||
can_ok($test->{info}, 'mibs');
|
|
||||||
|
|
||||||
subtest 'MIBs loaded subtest' => sub {
|
|
||||||
|
|
||||||
my $mibs = $test->{info}->mibs();
|
|
||||||
|
|
||||||
foreach my $key (keys %$mibs) {
|
|
||||||
my $qual_name = "$key" . '::' . "$mibs->{$key}";
|
|
||||||
ok(defined $SNMP::MIB{$mibs->{$key}}, "$qual_name defined");
|
|
||||||
like(SNMP::translateObj($qual_name),
|
|
||||||
qr/^(\.\d+)+$/, "$qual_name translates to a OID");
|
|
||||||
}
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub munge : Tests(2) {
|
|
||||||
my $test = shift;
|
|
||||||
|
|
||||||
can_ok($test->{info}, 'munge');
|
|
||||||
|
|
||||||
subtest 'Munges subtest' => sub {
|
|
||||||
|
|
||||||
my $test_munges = $test->{info}->munge();
|
|
||||||
foreach my $key (keys %$test_munges) {
|
|
||||||
isa_ok($test_munges->{$key}, 'CODE', "$key munge");
|
|
||||||
}
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub nosuch : Tests(2) {
|
sub nosuch : Tests(2) {
|
||||||
my $test = shift;
|
my $test = shift;
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user