Commit | Line | Data |
7a6a85bf |
1 | #!./perl |
7a6a85bf |
2 | # |
3 | # Copyright (c) 1995-2000, Raphael Manfredi |
4 | # |
9e21b3d0 |
5 | # You may redistribute only under the same terms as Perl 5, as specified |
6 | # in the README file that comes with the distribution. |
7a6a85bf |
7 | # |
7a6a85bf |
8 | |
9 | sub BEGIN { |
48c887dd |
10 | unshift @INC, 't'; |
9f233367 |
11 | require Config; import Config; |
0c384302 |
12 | if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { |
9f233367 |
13 | print "1..0 # Skip: Storable was not built\n"; |
14 | exit 0; |
15 | } |
372cb964 |
16 | require 'st-dump.pl'; |
7a6a85bf |
17 | } |
18 | |
19 | sub ok; |
20 | |
21 | use Storable qw(freeze thaw); |
22 | |
6bf6381f |
23 | print "1..19\n"; |
7a6a85bf |
24 | |
25 | package OVERLOADED; |
26 | |
27 | use overload |
28 | '""' => sub { $_[0][0] }; |
29 | |
30 | package main; |
31 | |
32 | $a = bless [77], OVERLOADED; |
33 | |
34 | $b = thaw freeze $a; |
35 | ok 1, ref $b eq 'OVERLOADED'; |
36 | ok 2, "$b" eq "77"; |
37 | |
38 | $c = thaw freeze \$a; |
39 | ok 3, ref $c eq 'REF'; |
40 | ok 4, ref $$c eq 'OVERLOADED'; |
41 | ok 5, "$$c" eq "77"; |
42 | |
43 | $d = thaw freeze [$a, $a]; |
44 | ok 6, "$d->[0]" eq "77"; |
45 | $d->[0][0]++; |
46 | ok 7, "$d->[1]" eq "78"; |
47 | |
b12202d0 |
48 | package REF_TO_OVER; |
49 | |
50 | sub make { |
51 | my $self = bless {}, shift; |
52 | my ($over) = @_; |
53 | $self->{over} = $over; |
54 | return $self; |
55 | } |
56 | |
57 | package OVER; |
58 | |
59 | use overload |
60 | '+' => \&plus, |
61 | '""' => sub { ref $_[0] }; |
62 | |
63 | sub plus { |
64 | return 314; |
65 | } |
66 | |
67 | sub make { |
68 | my $self = bless {}, shift; |
69 | my $ref = REF_TO_OVER->make($self); |
70 | $self->{ref} = $ref; |
71 | return $self; |
72 | } |
73 | |
74 | package main; |
75 | |
76 | $a = OVER->make(); |
77 | $b = thaw freeze $a; |
78 | |
79 | ok 8, ref $b eq 'OVER'; |
80 | ok 9, $a + $a == 314; |
81 | ok 10, ref $b->{ref} eq 'REF_TO_OVER'; |
82 | ok 11, "$b->{ref}->{over}" eq "$b"; |
83 | ok 12, $b + $b == 314; |
84 | |
165cc789 |
85 | # nfreeze data generated by make_overload.pl |
cf0d1c66 |
86 | my $f = ''; |
87 | if (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 | } |
165cc789 |
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'; |
6bf6381f |
101 | |
102 | |
103 | #--- |
104 | # blessed reference to overloded object. |
105 | { |
106 | my $a = bless [88], 'OVERLOADED'; |
107 | my $c = thaw freeze bless \$a, 'main'; |
108 | ok 17, ref $c eq 'main'; |
109 | ok 18, ref $$c eq 'OVERLOADED'; |
110 | ok 19, "$$c" eq "88"; |
111 | |
112 | } |
113 | |
b12202d0 |
114 | 1; |