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
|
#!/usr/bin/perl -w
BEGIN {
if ( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', '../ext/Test-Harness/t/lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use vars qw(%INIT %CUSTOM);
use Test::More tests => 14;
use File::Spec::Functions qw( catfile updir );
use_ok('TAP::Parser::SubclassTest');
# TODO: for my $source ( ... ) ?
my @t_path = $ENV{PERL_CORE} ? ( updir(), 'ext', 'Test-Harness' ) : ();
{ # perl source
%INIT = %CUSTOM = ();
my $source = catfile( @t_path, 't', 'subclass_tests', 'perl_source' );
my $p = TAP::Parser::SubclassTest->new( { source => $source } );
# The grammar is lazily constructed so we need to ask for it to
# trigger it's creation.
my $grammer = $p->_grammar;
ok( $p->{initialized}, 'new subclassed parser' );
is( $p->grammar_class => 'MyGrammar', 'grammar_class' );
is( $p->result_factory_class => 'MyResultFactory',
'result_factory_class'
);
is( $INIT{MyGrammar}, 1, 'initialized MyGrammar' );
is( $CUSTOM{MyGrammar}, 1, '... and it was customized' );
# make sure overrided make_* methods work...
%CUSTOM = ();
$p->make_grammar;
is( $CUSTOM{MyGrammar}, 1, 'make custom grammar' );
$p->make_result;
is( $CUSTOM{MyResult}, 1, 'make custom result' );
# make sure parser helpers use overrided classes too (the parser should
# be the central source of configuration/overriding functionality)
# The source is already tested above (parser doesn't keep a copy of the
# source currently). So only one to check is the Grammar:
%INIT = %CUSTOM = ();
my $r = $p->_grammar->tokenize;
isa_ok( $r, 'MyResult', 'i has results' );
is( $INIT{MyResult}, 1, 'initialized MyResult' );
is( $CUSTOM{MyResult}, 1, '... and it was customized' );
is( $INIT{MyResultFactory}, 1, '"initialized" MyResultFactory' );
}
SKIP: { # non-perl source
%INIT = %CUSTOM = ();
my $cat = '/bin/cat';
unless ( -e $cat ) {
skip "no '$cat'", 2;
}
my $file = catfile( @t_path, 't', 'data', 'catme.1' );
my $p = TAP::Parser::SubclassTest->new(
{ exec => [ $cat => $file ],
sources => { MySourceHandler => { accept_all => 1 } },
}
);
is( $CUSTOM{MySourceHandler}, 1, 'customized a MySourceHandler' );
is( $INIT{MyIterator}, 1, 'initialized MyIterator subclass' );
}
|
