#!./perl

#

#  Copyright (c) 1995-2000, Raphael Manfredi

#  

#  You may redistribute only under the same terms as Perl 5, as specified

#  in the README file that comes with the distribution.

#  

sub BEGIN {

    unshift @INC, 't';

    unshift @INC, 't/compat' if $] < 5.006002;

    require Config; import Config;

    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {

        print "1..0 # Skip: Storable was not built\n";

        exit 0;

    }

}

use Storable qw(freeze thaw);

$Storable::flags = Storable::FLAGS_COMPAT;

use Test::More tests => 19;

package OVERLOADED;

use overload

	'""' => sub { $_[0][0] };

package main;

$a = bless [77], OVERLOADED;

$b = thaw freeze $a;

is(ref $b, 'OVERLOADED');

is("$b", "77");

$c = thaw freeze \$a;

is(ref $c, 'REF');

is(ref $$c, 'OVERLOADED');

is("$$c", "77");

$d = thaw freeze [$a, $a];

is("$d->[0]", "77");

$d->[0][0]++;

is("$d->[1]", "78");

package REF_TO_OVER;

sub make {

	my $self = bless {}, shift;

	my ($over) = @_;

	$self->{over} = $over;

	return $self;

}

package OVER;

use overload

	'+'		=> \&plus,

	'""'	=> sub { ref $_[0] };

sub plus {

	return 314;

}

sub make {

	my $self = bless {}, shift;

	my $ref = REF_TO_OVER->make($self);

	$self->{ref} = $ref;

	return $self;

}

package main;

$a = OVER->make();

$b = thaw freeze $a;

is(ref $b, 'OVER');

is($a + $a, 314);

is(ref $b->{ref}, 'REF_TO_OVER');

is("$b->{ref}->{over}", "$b");

is($b + $b, 314);

# nfreeze data generated by make_overload.pl

my $f = '';

if (ord ('A') == 193) { # EBCDIC.

    $f = unpack 'u', q{7!084$0S(P>)MUN7%V=/6P<0*!**5EJ8`};

}else {

    $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`};

}

# see note at the end of do_retrieve in Storable.xs about why this test has to

# use a reference to an overloaded reference, rather than just a reference.

my $t = eval {thaw $f};

print "# $@" if $@;

is($@, "");

is(ref ($t), 'REF');

is(ref ($$t), 'HAS_OVERLOAD');

is($$$t, 'snow');

#---

# blessed reference to overloaded object.

{

  my $a = bless [88], 'OVERLOADED';

  my $c = thaw freeze bless \$a, 'main';

  is(ref $c, 'main');

  is(ref $$c, 'OVERLOADED');

  is("$$c", "88");

}

1;