#!/usr/bin/perl -w
use strict;
use Test::More 'no_plan'; # tests =>$n
use Test::Exception;

BEGIN { use_ok( 'Data::Rmap' ); }
use Data::Dumper;
$Data::Dumper::Purity=1;

our $data = {
          'arrays' => [[ 'shared', 'not_shared' ]],
          'num' => 2,
          'ref'  => \do { my $a = 'ref' },
          'hash' => {
                      'a' => 'vala',
                      'b' => 'valb',
					  'c' => { qn=> 'this' },
                    },
		  'ref_to_hash' => \{ qn=> 'that' },
        };

# shared value 
$data->{share_ref} = \$data->{arrays}[0][0];
$data->{another_obj} = \do{ my $o = ${$data->{ref_to_hash}}};

my $orig_dump = Dumper($data);

# do nothing slowly
rmap { } $data;
rmap_all { } $data;

# test importing imlicitly
use Data::Rmap qw(rmap_scalar);
rmap_scalar { } $data;
use Data::Rmap qw(:types rmap_to);
rmap_to { } HASH|ARRAY|SCALAR|REF|VALUE|GLOB, $data;
use Data::Rmap qw(:all);
rmap_hash { } $data;
rmap_array { } $data;

# check nothign changed
ok(Dumper($data) eq $orig_dump, 'nothing changed');

rmap { $_ = "#$_#"; } $data; # all the leaves

ok($data->{num} eq '#2#', "num #2#");
ok($data->{arrays}[0][0] eq '#shared#', "done once #shared#");
ok(${$data->{ref}} eq '#ref#', "${$data->{ref}} eq '#ref#'");
ok($data->{hash}{a} eq '#vala#', "nested hashes done #vala#");
ok(${$data->{ref_to_hash}}->{qn} eq '#that#', "ref_to_hash done #that#");

my $count = 1;
rmap_all {
	cut if ref($_) eq 'ARRAY';
	$_ = "=\U$_=" if !ref($_); # leaves
	$_->{qnum} = $count++ if ref($_) eq 'HASH' && exists $_->{qn};
} $data;
#diag(Dumper $data);

ok($data->{arrays}[0][1] eq '#not_shared#', 'ARRAY cut');
ok($data->{arrays}[0][0] eq '=#SHARED#=', 'cut one path only');
ok($data->{hash}{a} eq '=#VALA#=', 'HASH not cut');
like(${$data->{ref_to_hash}}->{qnum}, qr/^=\d+=$/, 'qnum added to qn');

# action only done once
$data = [];
$data->[0] = "string";
$data->[1] = \$data->[0];
$data->[2] = \\do{ my $s = "last" };

rmap { $_ = "!$_" } $data;
ok($data->[0] eq '!string', "done once");
ok(${$data->[1]} eq '!string', "access via both paths");
ok(\$data->[0] == \${$data->[1]}, "still same ref");
ok($${$data->[2]} eq '!last', "got '!last'");

# test aliasing with write only: ref => \'ref'
my $ro_err = qr/^Modification of a read-only value attempted/;
throws_ok { rmap { $_++ } 1 } $ro_err, 'read-only scalar';
throws_ok { rmap { $_++ } \1 } $ro_err, 'read-only scalar ref';
throws_ok { rmap { $_++ } [\1] } $ro_err, 'read-only scalar ref in array';
throws_ok { rmap { $_++ } {1,\1} } $ro_err, 'read-only scalar ref in hash';
*ro = \1; 
throws_ok { rmap { $_++ } *ro } $ro_err, 'read-only scalar ref in glob';

# test returns
is_deeply([ rmap { ++$_ } [1,2] ], [2,3], 'return altered pre-inc');
is_deeply([ rmap { $_++ } [1,2] ], [1,2], 'return not altered post-inc');
is( scalar(rmap { ++$_ } [2..4]), 3, 'scalar context num items');
our $rw = 2;
is_deeply([ rmap { ++$_ } [\do{my $a = 1}, \*rw] ], [2,3], 'flattens return');
is_deeply([ rmap { ++$_ } [1,[2]] ], [2,3], 'flattens 2');

# test cut
# take first element of each array reference found
is_deeply([ rmap_array { cut($_->[0]) } [1,0],[2,0,[0]],[[3],0], {0,\[4]} ],
			[                            1,    2,        [3],         4   ],
			'cut limits recursion');

is_deeply([ rmap { cut(++$_) } [1,2] ], [2,3], 'cut return altered pre-inc');
is_deeply([ rmap { ++$_; cut() } [1,2] ], [], 'cut can return nothing');

# test $_[0]->recurse
my ($array_dump) = rmap_to {
	return $_ unless ref($_);
	'[ ' . join(', ', $_[0]->recurse() ) . ' ]';
} ARRAY|VALUE,   [ 1, [ 2, [ [ 3 ], 4 ] ], 5 ];
is($array_dump, '[ 1, [ 2, [ [ 3 ], 4 ] ], 5 ]', 'dumper dumps');

my $tree = [
	one =>
	two => 
	[ 
		three_one => 
		three_two => 
		[ 
			three_three_one =>
		],
		three_four =>
	],
	four =>
	[
		[
			five_one_one =>
		],
	],
];

my $got = '';
our @path = ('q');
rmap_to {
	if(ref $_) {
		local(@path) = (@path, 1); # ARRAY adds a new level to the path
		$_[0]->recurse(); # does stuff within local(@path)'s scope
	} else {
		$got .= join('.', @path) . ' ';
	}
	$path[-1]++; # bump last element (even when it was an aref)
} ARRAY|VALUE, $tree;

is($got, 'q.1 q.2 q.3.1 q.3.2 q.3.3.1 q.3.4 q.4 q.5.1.1 ', 
			'tree numbering w/ recurse');


# test each name works as expected
our $x = 3;
my @types = (1, [], {}, \\2, \*x);
#$_ = join(' ', rmap_all { $_ } @types); s/\(.*?\)/\\S+/g; diag($_);
like(join(' ', 
	rmap { $_ } @types),
	qr/^1 2 3$/,
	'rmap types'
);

like(join(' ', 
	rmap_all { $_ } @types),
	qr/^1 ARRAY\S+ HASH\S+ (REF|SCALAR)\S+ SCALAR\S+ 2 GLOB\S+ SCALAR\S+ 3$/,
	'rmap_all types'
);

like(join(' ', 
	rmap_scalar { $_ } @types),
	qr/^1 (REF|SCALAR)\S+ SCALAR\S+ 2 SCALAR\S+ 3$/,
	'rmap_scalar types'
);

like(join(' ', 
	rmap_hash { $_ } @types),
	qr/^HASH\S+$/,
	'rmap_hash types'
);

like(join(' ', 
	rmap_array { $_ } @types),
	qr/^ARRAY\S+$/,
	'rmap_array types'
);

like(join(' ', 
	rmap_ref { $_ } @types),
	qr/^ARRAY\S+ HASH\S+ (REF|SCALAR)\S+ SCALAR\S+ SCALAR\S+$/,
	'rmap_ref types'
);


like(join(' ', 
	rmap_to { $_ } GLOB|HASH, @types),
	qr/^HASH\S+ GLOB\S+$/,
	'rmap_to GLOB|HASH types'
);