/
BaseTest.pm
79 lines (50 loc) · 1.09 KB
/
BaseTest.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
#! /usr/bin/perl -w
package Test::Class::BaseTest;
use base qw(Test::Class);
use strict;
use warnings;
use Carp;
use Test::More;
=head1 NAME
Test::BaseTest - Useful base class for your Test::Class objects
=cut
=over 4
=item B<create_class>
=cut
sub create_class {
my $self = shift;
return $self->{class} if exists $self->{class};
my $class = ref($self);
croak "expecting ClassToTest::Test, found $class"
unless $class =~ m/^(.*)::Test/s;
return($1);
};
=item B<create_method>
=cut
sub create_method { shift->{method} || "new" };
=item B<create_args>
=cut
sub create_args {
my $args = shift->{args} || [];
return @$args;
};
=item B<Create_fixture>
=cut
sub Create_fixture : Test(setup) {
my $self = shift;
my $method = $self->create_method;
my @args = $self->create_args;
my $class = $self->create_class;
$self->{object} = $class->$method(@args);
};
=item B<Check_fixture>
=cut
sub Check_fixture : Test {
my $self = shift;
my $class = $self->create_class;
isa_ok($self->{object}, $class)
|| $self->FAIL_ALL("could not create $class fixture");
};
=back
=cut
1;