The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

my ($last_test,$loaded);

######################### We start with some black magic to print on failure.
use lib '../blib/lib','../blib/arch';

BEGIN { $last_test = 28; $| = 1; print "1..$last_test\n"; }
END   { print "not ok 1  Can't load Data::Walker\n" unless $loaded; }

use Data::Walker;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

my $tcounter = 1;
my $want     = '';
my $id       = '\(0x.+\)';  # Regex to match the id of stringified refs

my $w        = new Data::Walker;
my $s        = {};

my $perl_version = $];


sub test {
	$tcounter++;

	my $string = shift;
	my $ret = eval $string;
	$ret = 'undef' if not defined $ret;

	if("$ret" =~ /^$want$/m) {

		print "ok $tcounter\n";

	} else {
		print "not ok $tcounter\n",
		"   -- '$string' returned '$ret'\n", 
		"   -- expected =~ /$want/\n"
	}
}


#------------------------------------------------------
# Our test data structure
#
$s = {
	a => [ 10, 20, "thirty" ],
	b => {
		"w" => "forty",
		"x" => "fifty",
		"y" => 60,
		"z" => \70,
	},
	c => sub { return "function"; },
	d => 80,
 	e => \[ "m", "n" ],
};
$s->{f}      = \$s->{d};
$s->{b}->{v} =  $s->{b};   #recursive

bless $s, Data::Walker;


#------------------------------------------------------
# Test basic formatting
#
$want = 'ARRAY';              test q($w->printref( $s->{a} )); 
$want = 'HASH';               test q($w->printref( $s->{b} ));
$want = 'CODE';               test q($w->printref( $s->{c} ));
$want = 'scalar';             test q($w->printref( $s->{d} ));
$want = 'Data::Walker=HASH';  test q($w->printref( $s      ));

#------------------------------------------------------
# Test ref-to-refs
#
$want = 'REF->ARRAY';         test q($w->printref(\$s->{a} ));
$want = 'REF->HASH';          test q($w->printref(\$s->{b} ));
$want = 'REF->CODE';          test q($w->printref(\$s->{c} ));
$want = 'SCALAR';             test q($w->printref(\$s->{d} ));
$want = 'REF->Data::Walker=HASH'; 
                              test q($w->printref(\$s      ));

#------------------------------------------------------
# Test formatting with ids
#
$w->showids(1);
#
$want = "ARRAY$id";              test q($w->printref( $s->{a} ));
$want = "HASH$id";               test q($w->printref( $s->{b} ));
$want = "CODE$id";               test q($w->printref( $s->{c} ));
$want = "Data::Walker=HASH$id";  test q($w->printref( $s      ));
$want = "REF$id->ARRAY$id";      test q($w->printref(\$s->{a} ));
$want = "SCALAR$id";             test q($w->printref(\$s->{d} ));
#
$w->showids(0);


#------------------------------------------------------
# Test walking up and down trees
# 
$w->warning(0);          # Hide Data::Walker warnings during tests
$w->{namepath} = ['/'];  # Set during CLI;  fudge it here
$w->{refpath} = [$s];    # Set during CLI;  fudge it here
#
$want = "ARRAY$id";              test q($w->down("a", $s->{a}));
$want = "Data::Walker=HASH$id";  test q($w->up() );
$want = "HASH$id";               test q($w->down("b", $s->{b}));
$want = "Data::Walker=HASH$id";  test q($w->up() );
$want = "undef";                 test q($w->down("c", $s->{c}));
$want = "Data::Walker=HASH$id";  test q($w->up() );
$want = "undef";                 test q($w->down("d", $s->{d}));


#------------------------------------------------------
# Test walking up and down trees with ref-to-refs
# 
$w->skipdoublerefs(1);
#
$want = "ARRAY$id";              test q($w->down("e", $s->{e}));
$want = "Data::Walker=HASH$id";  test q($w->up() );
#
$w->skipdoublerefs(0);
#
if($perl_version >= 5.008) {
	$want = "REF$id";             test q($w->down("e", $s->{e}));
} else {
	$want = "SCALAR$id";          test q($w->down("e", $s->{e}));
}
$want = "Data::Walker=HASH$id";  test q($w->up());