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
|
#!/usr/bin/perl
# Unit testing for PPI::Token::Prototype
use lib 't/lib';
use PPI::Test::pragmas;
use Test::More tests => 800 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
use PPI;
PARSING: {
for my $name (
'sub foo',
'sub foo ',
'sub',
'sub ',
'sub AUTOLOAD',
'sub AUTOLOAD ',
'sub DESTROY',
'sub DESTROY ',
) {
for my $block ( '{1;}', ';' ) {
for my $proto_and_expected (
[ '', '', '' ],
[ '()', '()', '' ],
[ '( )', '( )', '' ],
[ ' () ',, '()', '' ],
[ '(+@)', '(+@)', '+@' ],
[ ' (+@) ', '(+@)', '+@' ],
[ '(\[$;$_@])', '(\[$;$_@])', '\[$;$_@]' ],
[ '(\ [ $ ])', '(\ [ $ ])', '\[$]' ],
[ '(\\\ [ $ ])', '(\\\ [ $ ])', '\\\[$]' ], # nonsense, but perl accepts it
[ '($ _ %)', '($ _ %)', '$_%' ],
[ '( Z)', '( Z)', 'Z' ], # invalid chars in prototype
[ '(!-=|)', '(!-=|)', '!-=|' ], # invalid chars in prototype
[ '(()', '(()', '(' ], # perl refuses to compile this
) {
my ( $code_prototype, $expected_content, $expected_prototype ) = @$proto_and_expected;
my $code = "$name$code_prototype$block";
my $document = PPI::Document->new( \$code );
isa_ok( $document, 'PPI::Document', $code );
my $all_prototypes = $document->find( 'PPI::Token::Prototype' );
if ( $code_prototype eq '' ) {
is( $all_prototypes, "", "$code: got no prototypes" );
}
else {
$all_prototypes = [] if !ref $all_prototypes;
is( scalar(@$all_prototypes), 1, "$code: got exactly one prototype" );
my $prototype_obj = $all_prototypes->[0];
is( $prototype_obj, $expected_content, "$code: prototype object content matches" );
is( $prototype_obj->prototype, $expected_prototype, "$code: prototype characters match" );
}
}
}
}
}
|
