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>; | ||||
|  | ||||
| # 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 } | ||||
|  | ||||
| my $EMPTY = q{}; | ||||
| @@ -79,6 +82,97 @@ sub teardown : Tests(teardown) { | ||||
|   $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 { | ||||
|  | ||||
|   my $home = dir($ENV{HOME}, 'netdisco-mibs'); | ||||
|   | ||||
		Reference in New Issue
	
	Block a user