1#!./perl 2# 3# Copyright (c) 1995-2000, Raphael Manfredi 4# 5# You may redistribute only under the same terms as Perl 5, as specified 6# in the README file that comes with the distribution. 7# 8 9sub BEGIN { 10 unshift @INC, 't'; 11 unshift @INC, 't/compat' if $] < 5.006002; 12 require Config; import Config; 13 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 14 print "1..0 # Skip: Storable was not built\n"; 15 exit 0; 16 } 17} 18 19use Storable qw(freeze thaw); 20 21$Storable::flags = Storable::FLAGS_COMPAT; 22 23use Test::More tests => 19; 24 25package OVERLOADED; 26 27use overload 28 '""' => sub { $_[0][0] }; 29 30package main; 31 32$a = bless [77], OVERLOADED; 33 34$b = thaw freeze $a; 35is(ref $b, 'OVERLOADED'); 36is("$b", "77"); 37 38$c = thaw freeze \$a; 39is(ref $c, 'REF'); 40is(ref $$c, 'OVERLOADED'); 41is("$$c", "77"); 42 43$d = thaw freeze [$a, $a]; 44is("$d->[0]", "77"); 45$d->[0][0]++; 46is("$d->[1]", "78"); 47 48package REF_TO_OVER; 49 50sub make { 51 my $self = bless {}, shift; 52 my ($over) = @_; 53 $self->{over} = $over; 54 return $self; 55} 56 57package OVER; 58 59use overload 60 '+' => \&plus, 61 '""' => sub { ref $_[0] }; 62 63sub plus { 64 return 314; 65} 66 67sub make { 68 my $self = bless {}, shift; 69 my $ref = REF_TO_OVER->make($self); 70 $self->{ref} = $ref; 71 return $self; 72} 73 74package main; 75 76$a = OVER->make(); 77$b = thaw freeze $a; 78 79is(ref $b, 'OVER'); 80is($a + $a, 314); 81is(ref $b->{ref}, 'REF_TO_OVER'); 82is("$b->{ref}->{over}", "$b"); 83is($b + $b, 314); 84 85# nfreeze data generated by make_overload.pl 86my $f = ''; 87if (ord ('A') == 193) { # EBCDIC. 88 $f = unpack 'u', q{7!084$0S(P>)MUN7%V=/6P<0*!**5EJ8`}; 89}else { 90 $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`}; 91} 92 93# see note at the end of do_retrieve in Storable.xs about why this test has to 94# use a reference to an overloaded reference, rather than just a reference. 95my $t = eval {thaw $f}; 96print "# $@" if $@; 97is($@, ""); 98is(ref ($t), 'REF'); 99is(ref ($$t), 'HAS_OVERLOAD'); 100is($$$t, 'snow'); 101 102 103#--- 104# blessed reference to overloaded object. 105{ 106 my $a = bless [88], 'OVERLOADED'; 107 my $c = thaw freeze bless \$a, 'main'; 108 is(ref $c, 'main'); 109 is(ref $$c, 'OVERLOADED'); 110 is("$$c", "88"); 111 112} 113 1141; 115