6 use Test::More tests => 227;
8 use TAP::Parser::ResultFactory;
9 use TAP::Parser::Result;
11 use constant RESULT => 'TAP::Parser::Result';
12 use constant PLAN => 'TAP::Parser::Result::Plan';
13 use constant TEST => 'TAP::Parser::Result::Test';
14 use constant COMMENT => 'TAP::Parser::Result::Comment';
15 use constant BAILOUT => 'TAP::Parser::Result::Bailout';
16 use constant UNKNOWN => 'TAP::Parser::Result::Unknown';
19 $SIG{__WARN__} = sub { $warning = shift };
22 # Note that the are basic unit tests. More comprehensive path coverage is
23 # found in the regression tests.
26 my $factory = TAP::Parser::ResultFactory->new;
27 my %inherited_methods = (
36 my $abstract_class = bless { type => 'no_such_type' },
37 RESULT; # you didn't see this
38 run_method_tests( $abstract_class, {} ); # check the defaults
40 can_ok $abstract_class, 'type';
41 is $abstract_class->type, 'no_such_type',
42 '... and &type should return the correct result';
44 can_ok $abstract_class, 'passed';
46 ok $abstract_class->passed, '... and it should default to true';
47 like $warning, qr/^\Qpassed() is deprecated. Please use "is_ok()"/,
48 '... but it should emit a deprecation warning';
52 can_ok $factory, 'make_result';
53 eval { $factory->make_result( { type => 'no_such_type' } ) };
54 ok my $error = $@, '... and calling it with an unknown class should fail';
55 like $error, qr/^Could not determine class for.*no_such_type/s,
56 '... with an appropriate error message';
58 # register new Result types:
59 can_ok $factory, 'class_for';
60 can_ok $factory, 'register_type';
65 use vars qw($VERSION @ISA);
66 @ISA = 'TAP::Parser::Result';
67 TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
71 my $r = eval { $factory->make_result( { type => 'my_type' } ) };
73 isa_ok( $r, 'MyResult', 'register custom type' );
74 ok( !$error, '... and no error' );
85 raw => '... this line is junk ... ',
89 raw => '... this line is junk ... ',
90 as_string => '... this line is junk ... ',
104 raw => '# this is a comment',
105 comment => 'this is a comment',
109 raw => '# this is a comment',
110 as_string => '# this is a comment',
111 comment => 'this is a comment',
118 # test bailout tokens
125 raw => 'Bailout! This blows!',
126 bailout => 'This blows!',
130 raw => 'Bailout! This blows!',
131 as_string => 'This blows!',
164 raw => '1..0 # SKIP help me, Rhonda!',
167 explanation => 'help me, Rhonda!',
171 raw => '1..0 # SKIP help me, Rhonda!',
174 explanation => 'help me, Rhonda!',
183 my $test = run_tests(
188 description => '... and this test is fine',
191 raw => 'ok 5 and this test is fine',
199 description => '... and this test is fine',
207 as_string => 'ok 5 ... and this test is fine',
213 can_ok $test, 'actual_passed';
215 is $test->actual_passed, $test->is_actual_ok,
216 '... and it should return the correct value';
218 qr/^\Qactual_passed() is deprecated. Please use "is_actual_ok()"/,
219 '... but issue a deprecation warning';
221 can_ok $test, 'todo_failed';
223 is $test->todo_failed, $test->todo_passed,
224 '... and it should return the correct value';
226 qr/^\Qtodo_failed() is deprecated. Please use "todo_passed()"/,
227 '... but issue a deprecation warning';
236 description => '... and this test is fine',
238 explanation => 'why not?',
239 raw => 'not ok 5 and this test is fine # TODO why not?',
247 description => '... and this test is fine',
249 explanation => 'why not?',
256 'not ok 5 ... and this test is fine # TODO why not?',
263 my ( $instantiated, $value_for ) = @_;
264 my $result = instantiate($instantiated);
265 run_method_tests( $result, $value_for );
270 my $instantiated = shift;
271 my $class = $instantiated->{class};
272 ok my $result = $factory->make_result( $instantiated->{data} ),
273 'Creating $class results should succeed';
274 isa_ok $result, $class, '.. and the object it returns';
278 sub run_method_tests {
279 my ( $result, $value_for ) = @_;
280 while ( my ( $method, $default ) = each %inherited_methods ) {
281 can_ok $result, $method;
282 if ( defined( my $value = delete $value_for->{$method} ) ) {
283 is $result->$method(), $value,
284 "... and $method should be correct";
287 is $result->$method(), $default,
288 "... and $method default should be correct";
291 while ( my ( $method, $value ) = each %$value_for ) {
292 can_ok $result, $method;
293 is $result->$method(), $value, "... and $method should be correct";