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
|
#!/usr/bin/perl
use strict;
BEGIN {
no warnings 'once';
$| = 1;
$PPI::XS_DISABLE = 1;
$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
}
use Test::More 0.86 tests => 24;
use Test::NoWarnings;
use File::Spec::Functions ':ALL';
use File::Remove;
use PPI;
use PPI::Transform;
# Files to clean up
my @cleanup = ();
END {
foreach ( @cleanup ) {
File::Remove::remove( \1, $_ );
}
}
#####################################################################
# Begin Tests
my $code = 'my $foo = "bar";';
my $rv = MyCleaner->apply( \$code );
ok( $rv, 'MyCleaner->apply( \$code ) returns true' );
is( $code, 'my$foo="bar";', 'MyCleaner->apply( \$code ) modifies code as expected' );
ok(
PPI::Transform->register_apply_handler( 'Foo', \&Foo::get, \&Foo::set ),
"register_apply_handler worked",
);
$Foo::VALUE = 'my $foo = "bar";';
my $Foo = Foo->new;
isa_ok( $Foo, 'Foo' );
ok( MyCleaner->apply( $Foo ), 'MyCleaner->apply( $Foo ) returns true' );
is( $Foo::VALUE, 'my$foo="bar";', 'MyCleaner->apply( $Foo ) modifies code as expected' );
#####################################################################
# File transforms
use Scalar::Util 'refaddr';
use File::Copy;
my $testdir = catdir( 't', 'data', '15_transform');
# Does the test directory exist?
ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" );
# Find the .pm test files
opendir( TESTDIR, $testdir ) or die "opendir: $!";
my @files = map { catfile( $testdir, $_ ) } sort grep { /\.pm$/ } readdir(TESTDIR);
closedir( TESTDIR ) or die "closedir: $!";
ok( scalar @files, 'Found at least one .pm file' );
#####################################################################
# Testing
foreach my $input ( @files ) {
# Prepare
my $output = "${input}_out";
my $copy = "${input}_copy";
my $copy2 = "${input}_copy2";
push @cleanup, $copy;
push @cleanup, $copy2;
ok( copy( $input, $copy ), "Copied $input to $copy" );
my $Original = new_ok( 'PPI::Document' => [ $input ] );
my $Input = new_ok( 'PPI::Document' => [ $input ] );
my $Output = new_ok( 'PPI::Document' => [ $output ] );
# Process the file
my $rv = MyCleaner->document( $Input );
isa_ok( $rv, 'PPI::Document' );
is( refaddr($rv), refaddr($Input), '->document returns original document' );
is_deeply( $Input, $Output, 'Transform works as expected' );
# Squish to another location
ok( MyCleaner->file( $copy, $copy2 ), '->file returned true' );
my $Copy = new_ok( 'PPI::Document' => [ $copy ] );
is_deeply( $Copy, $Original, 'targeted transform leaves original unchanged' );
my $Copy2 = new_ok( 'PPI::Document' => [ $copy2 ] );
is_deeply( $Copy2, $Output, 'targeted transform works as expected' );
# Copy the file and process in-place
ok( MyCleaner->file( $copy ), '->file returned true' );
$Copy = new_ok( 'PPI::Document' => [ $copy ] );
is_deeply( $Copy, $Output, 'In-place transform works as expected' );
}
#####################################################################
# Support Code
# Test Transform class
package MyCleaner;
use Params::Util qw{_INSTANCE};
use PPI::Transform ();
use vars qw{@ISA};
BEGIN {
@ISA = 'PPI::Transform';
}
sub document {
my $self = shift;
my $Document = _INSTANCE(shift, 'PPI::Document') or return undef;
$Document->prune( 'Token::Whitespace' );
$Document;
}
package Foo;
sub new {
bless { }, 'Foo';
}
use vars qw{$VALUE};
BEGIN {
$VALUE = '';
}
sub get {
PPI::Document->new( \$VALUE );
}
sub set {
$VALUE = $_[1]->serialize;
}
|
