Store weak references.
[p5sagit/p5-mst-13.2.git] / ext / Storable / t / overload.t
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
9 sub BEGIN {
10     if ($ENV{PERL_CORE}){
11         chdir('t') if -d 't';
12         @INC = ('.', '../lib', '../ext/Storable/t');
13     } else {
14         unshift @INC, 't';
15     }
16     require Config; import Config;
17     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
18         print "1..0 # Skip: Storable was not built\n";
19         exit 0;
20     }
21     require 'st-dump.pl';
22 }
23
24 sub ok;
25
26 use Storable qw(freeze thaw);
27
28 print "1..16\n";
29
30 package OVERLOADED;
31
32 use overload
33         '""' => sub { $_[0][0] };
34
35 package main;
36
37 $a = bless [77], OVERLOADED;
38
39 $b = thaw freeze $a;
40 ok 1, ref $b eq 'OVERLOADED';
41 ok 2, "$b" eq "77";
42
43 $c = thaw freeze \$a;
44 ok 3, ref $c eq 'REF';
45 ok 4, ref $$c eq 'OVERLOADED';
46 ok 5, "$$c" eq "77";
47
48 $d = thaw freeze [$a, $a];
49 ok 6, "$d->[0]" eq "77";
50 $d->[0][0]++;
51 ok 7, "$d->[1]" eq "78";
52
53 package REF_TO_OVER;
54
55 sub make {
56         my $self = bless {}, shift;
57         my ($over) = @_;
58         $self->{over} = $over;
59         return $self;
60 }
61
62 package OVER;
63
64 use overload
65         '+'             => \&plus,
66         '""'    => sub { ref $_[0] };
67
68 sub plus {
69         return 314;
70 }
71
72 sub make {
73         my $self = bless {}, shift;
74         my $ref = REF_TO_OVER->make($self);
75         $self->{ref} = $ref;
76         return $self;
77 }
78
79 package main;
80
81 $a = OVER->make();
82 $b = thaw freeze $a;
83
84 ok 8, ref $b eq 'OVER';
85 ok 9, $a + $a == 314;
86 ok 10, ref $b->{ref} eq 'REF_TO_OVER';
87 ok 11, "$b->{ref}->{over}" eq "$b";
88 ok 12, $b + $b == 314;
89
90 # nfreeze data generated by make_overload.pl
91 my $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`};
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.
95 my $t = eval {thaw $f};
96 print "# $@" if $@;
97 ok 13, $@ eq "";
98 ok 14, ref ($t) eq 'REF';
99 ok 15, ref ($$t) eq 'HAS_OVERLOAD';
100 ok 16, $$$t eq 'snow';
101 1;