#!/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;