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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
package PPI::Test::Run;
use File::Spec::Functions ':ALL';
use Params::Util qw{_INSTANCE};
use PPI::Document;
use PPI::Dumper;
use Test::More;
use Test::Object;
use lib 't/lib';
use PPI::Test::Object;
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.236';
}
#####################################################################
# Process a .code/.dump file pair
# plan: 2 + 14 * npairs
sub run_testdir {
my $pkg = shift;
my $testdir = catdir(@_);
# Does the test directory exist?
ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" );
# Find the .code test files
local *TESTDIR;
opendir( TESTDIR, $testdir ) or die "opendir: $!";
my @code = map { catfile( $testdir, $_ ) } sort grep { /\.code$/ } readdir(TESTDIR);
closedir( TESTDIR ) or die "closedir: $!";
ok( scalar @code, 'Found at least one code file' );
foreach my $codefile ( @code ) {
# Does the .code file have a matching .dump file
my $dumpfile = $codefile;
$dumpfile =~ s/\.code$/\.dump/;
my $codename = $codefile;
$codename =~ s/\.code$//;
ok( (-f $dumpfile and -r $dumpfile), "$codename: Found matching .dump file" );
# Create the lexer and get the Document object
my $document = PPI::Document->new( $codefile );
ok( $document, "$codename: Lexer->Document returns true" );
ok( _INSTANCE($document, 'PPI::Document'), "$codename: Object isa PPI::Document" );
my $rv;
local *CODEFILE;
SKIP: {
skip "No Document to test", 12 unless $document;
# Index locations
ok( $document->index_locations, "$codename: ->index_locations ok" );
# Check standard things
object_ok( $document ); # 7 tests contained within
# Get the dump array ref for the Document object
my $Dumper = PPI::Dumper->new( $document );
ok( _INSTANCE($Dumper, 'PPI::Dumper'), "$codename: Object isa PPI::Dumper" );
my @dump_list = $Dumper->list;
ok( scalar @dump_list, "$codename: Got dump content from dumper" );
# Try to get the .dump file array
local *DUMP;
open( DUMP, '<', $dumpfile ) or die "open: $!";
my @content = <DUMP>;
close( DUMP ) or die "close: $!";
chomp @content;
# Compare the two
{
local $TODO = $ENV{TODO} if $ENV{TODO};
is_deeply( \@dump_list, \@content, "$codename: Generated dump matches stored dump" );
}
# Also, do a round-trip check
$rv = open( CODEFILE, '<', $codefile );
ok( $rv, "$codename: Opened file" );
}
SKIP: {
unless ( $document and $rv ) {
skip "Missing file", 1;
}
my $source = do { local $/ = undef; <CODEFILE> };
close CODEFILE;
$source =~ s/(?:\015{1,2}\012|\015|\012)/\n/g;
is( $document->serialize, $source, "$codename: Round-trip back to source was ok" );
}
}
}
#####################################################################
# Process a .code/.dump file pair
# plan: 2 + 14 * npairs
sub increment_testdir {
my $pkg = shift;
my $testdir = catdir(@_);
# Does the test directory exist?
ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" );
# Find the .code test files
local *TESTDIR;
opendir( TESTDIR, $testdir ) or die "opendir: $!";
my @code = map { catfile( $testdir, $_ ) } sort grep { /\.code$/ } readdir(TESTDIR);
closedir( TESTDIR ) or die "closedir: $!";
ok( scalar @code, 'Found at least one code file' );
foreach my $codefile ( @code ) {
# Does the .code file have a matching .dump file
my $codename = $codefile;
$codename =~ s/\.code$//;
# Load the file
local *CODEFILE;
local $/ = undef;
open( CODEFILE, '<', $codefile ) or die "open: $!";
my $buffer = <CODEFILE>;
close( CODEFILE ) or die "close: $!";
# Cover every possible transitional state in
# the regression test code fragments.
foreach my $chars ( 1 .. length($buffer) ) {
my $string = substr( $buffer, 0, $chars );
my $document = eval {
PPI::Document->new( \$string );
};
is(
$@ => '',
"$codename: $chars chars ok",
);
is(
ref($document) => 'PPI::Document',
"$codename: $chars chars document",
);
is(
$document->serialize => $string,
"$codename: $chars char roundtrip",
);
}
}
}
1;
|
