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
155
156
|
#!/usr/bin/perl
# Test compatibility with Storable
use strict;
BEGIN {
no warnings 'once';
$| = 1;
$PPI::XS_DISABLE = 1;
$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
}
use Test::More tests => 43;
use Test::NoWarnings;
use File::Spec::Unix;
use File::Spec::Functions ':ALL';
use Scalar::Util 'refaddr';
use File::Remove ();
use PPI::Document ();
use PPI::Cache ();
use constant VMS => !! ( $^O eq 'VMS' );
use constant FILE => VMS ? 'File::Spec::Unix' : 'File::Spec';
my $this_file = FILE->catdir( 't', 'data', '03_document', 'test.dat' );
my $cache_dir = FILE->catdir( 't', 'data', '18_cache' );
# Define, create and clear the test cache
File::Remove::remove( \1, $cache_dir ) if -e $cache_dir;
ok( ! -e $cache_dir, 'The cache path does not exist' );
END { File::Remove::remove( \1, $cache_dir ) if -e $cache_dir }
ok( scalar(mkdir $cache_dir), 'mkdir $cache_dir returns true' );
ok( -d $cache_dir, 'Verified the cache path exists' );
ok( -w $cache_dir, 'Can write to the cache path' );
my $sample_document = \'print "Hello World!\n";';
#####################################################################
# Basic Testing
# Create a basic cache object
my $Cache = PPI::Cache->new(
path => $cache_dir,
);
isa_ok( $Cache, 'PPI::Cache' );
is( scalar($Cache->path), $cache_dir, '->path returns the original path' );
is( scalar($Cache->readonly), '', '->readonly returns false by default' );
# Create a test document
my $doc = PPI::Document->new( $sample_document );
isa_ok( $doc, 'PPI::Document' );
my $doc_md5 = '64568092e7faba16d99fa04706c46517';
is( $doc->hex_id, $doc_md5, '->hex_id specifically matches the UNIX newline md5' );
my $doc_file = catfile($cache_dir, '6', '64', '64568092e7faba16d99fa04706c46517.ppi');
my $bad_md5 = 'abcdef1234567890abcdef1234567890';
my $bad_file = catfile($cache_dir, 'a', 'ab', 'abcdef1234567890abcdef1234567890.ppi');
# Save to an arbitrary location
ok( $Cache->_store($bad_md5, $doc), '->_store returns true' );
ok( -f $bad_file, 'Created file where expected' );
my $loaded = $Cache->_load($bad_md5);
isa_ok( $loaded, 'PPI::Document' );
is_deeply( $doc, $loaded, '->_load loads the same document back in' );
# Store the test document in the cache in it's proper place
is( scalar( $Cache->store_document($doc) ), 1,
'->store_document(Document) returns true' );
ok( -f $doc_file, 'The document was stored in the expected location' );
# Check the _md5hex method
is( PPI::Cache->_md5hex($sample_document), $doc_md5,
'->_md5hex returns as expected for sample document' );
is( PPI::Cache->_md5hex($doc_md5), $doc_md5,
'->_md5hex null transform works as expected' );
is( $Cache->_md5hex($sample_document), $doc_md5,
'->_md5hex returns as expected for sample document' );
is( $Cache->_md5hex($doc_md5), $doc_md5,
'->_md5hex null transform works as expected' );
# Retrieve the Document by content
$loaded = $Cache->get_document( $sample_document );
isa_ok( $loaded, 'PPI::Document' );
is_deeply( $doc, $loaded, '->get_document(\$source) loads the same document back in' );
# Retrieve the Document by md5 directly
$loaded = $Cache->get_document( $doc_md5 );
isa_ok( $loaded, 'PPI::Document' );
is_deeply( $doc, $loaded, '->get_document($md5hex) loads the same document back in' );
#####################################################################
# Empiric Testing
# Load a test document twice, and see how many tokenizer objects get
# created internally.
is( PPI::Document->get_cache, undef, 'PPI::Document cache initially undef' );
ok( PPI::Document->set_cache( $Cache ), 'PPI::Document->set_cache returned true' );
isa_ok( PPI::Document->get_cache, 'PPI::Cache' );
is( refaddr($Cache), refaddr(PPI::Document->get_cache),
'->get_cache returns the same cache object' );
SKIP: {
skip("Test::SubCalls requires >= 5.6", 7 ) if $] < 5.006;
require Test::SubCalls;
# Set the tracking on the Tokenizer constructor
ok( Test::SubCalls::sub_track( 'PPI::Tokenizer::new' ), 'Tracking calls to PPI::Tokenizer::new' );
Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0 );
my $doc1 = PPI::Document->new( $this_file );
my $doc2 = PPI::Document->new( $this_file );
isa_ok( $doc1, 'PPI::Document' );
isa_ok( $doc2, 'PPI::Document' );
unless ( $doc1 and $doc2 ) {
skip( "Skipping due to previous failures", 3 );
}
Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 1,
'Two calls to PPI::Document->new results in one Tokenizer object creation' );
ok( refaddr($doc1) != refaddr($doc2),
'PPI::Document->new with cache enabled does NOT return the same object' );
is_deeply( $doc1, $doc2,
'PPI::Document->new with cache enabled returns two identical objects' );
}
SKIP: {
skip("Test::SubCalls requires >= 5.6", 8 ) if $] < 5.006;
# Done now, can we clear the cache?
is( PPI::Document->set_cache(undef), 1, '->set_cache(undef) returns true' );
is( PPI::Document->get_cache, undef, '->get_cache returns undef' );
# Next, test the import mechanism
local $@;
eval "use PPI::Cache path => '$cache_dir';";
is( $@, '', 'use PPI::Cache path => ...; succeeded' );
isa_ok( PPI::Document->get_cache, 'PPI::Cache' );
is( scalar(PPI::Document->get_cache->path), $cache_dir, '->path returns the original path' );
is( scalar(PPI::Document->get_cache->readonly), '', '->readonly returns false by default' );
# Does it still keep the previously cached documents
Test::SubCalls::sub_reset( 'PPI::Tokenizer::new' );
my $doc3 = PPI::Document->new( $this_file );
isa_ok( $doc3, 'PPI::Document' );
Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0,
'Tokenizer was not created. Previous cache used ok' );
}
1;
|
