#!perl -w

use strict;
no strict "vars";

use Data::Locations;

# ======================================================================
#   $toplocation = Data::Locations->new();
#   $sublocation = $location->new();
#   $refs = $location->_mortalize_();
#   $location->_resurrect_($refs);
# ======================================================================

print "1..40\n";

$n = 1;

no strict "refs";
$loc = \*{'Data::Locations::LOCATION'};
use strict "refs";
bless($loc, 'Data::Locations');

&check($loc,1);

tie(*{$loc}, 'Data::Locations', $loc);

$fix = &check($loc,2,1);

${*{$loc}} = $loc;

&check($loc,3+$fix);

delete $Data::Locations::{'LOCATION'};

&check($loc,2+$fix);

$top = Data::Locations->new();

&check($top,0);

$sub = $top->new();

&check($top,0);

&check($sub,1);

@{*{$top}} = ();

&check($top,0);

&check($sub,0);

if (${*{$top}}{'refs'} == 3+$fix)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

if (${*{$sub}}{'refs'} == 3+$fix)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

no strict "refs";
$fake = \${'Data::Locations::LOCATION'};
use strict "refs";
bless($fake, 'Data::Locations');

eval { $refs = $fake->_mortalize_(); };
if ($@ =~ /Data::Locations::_mortalize_\(\): item is not a "Data::Locations" object/)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { $fake->_resurrect_($refs); };
if ($@ =~ /Data::Locations::_resurrect_\(\): item is not a "Data::Locations" object/)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

exit;

sub check
{
    my($obj,$refs,$lax) = @_;
    my($test1,$test2,$fix);

    $refs++;
    $fix = 0;
    $test1 = &Data::Locations::_mortalize_($obj);
    if ($test1 == $refs or ($lax and $test1 == ($refs + --$fix)))
    {print "ok $n\n";} else {print "not ok $n\n";}
    $n++;

    if ($obj->_mortalize_() == 0)
    {print "ok $n\n";} else {print "not ok $n\n";}
    $n++;

    &Data::Locations::_resurrect_($obj,$test1);

    $test2 = &Data::Locations::_mortalize_($obj);
    if ($test2 == $refs or ($lax and $test2 == ($refs + $fix)))
    {print "ok $n\n";} else {print "not ok $n\n";}
    $n++;

    if ($obj->_mortalize_() == 0)
    {print "ok $n\n";} else {print "not ok $n\n";}
    $n++;

    $obj->_resurrect_($test2);

    return $fix if ($lax);
}

__END__