3 # $Id: recurse.t,v 1.0.1.2 2000/11/05 17:22:05 ram Exp ram $
5 # Copyright (c) 1995-2000, Raphael Manfredi
7 # You may redistribute only under the same terms as Perl 5, as specified
8 # in the README file that comes with the distribution.
11 # Revision 1.0.1.2 2000/11/05 17:22:05 ram
12 # patch6: stress hook a little more with refs to lexicals
15 # Revision 1.0.1.1 2000/09/17 16:48:05 ram
16 # patch1: added test case for store hook bug
19 # Revision 1.0 2000/09/01 19:40:42 ram
20 # Baseline for first official release.
27 require Config; import Config;
28 if ($Config{'extensions'} !~ /\bStorable\b/) {
29 print "1..0 # Skip: Storable was not built\n";
32 require 'lib/st-dump.pl';
37 use Storable qw(freeze thaw dclone);
43 use Storable qw(freeze thaw);
47 sub make { bless [], shift }
52 die "STORABLE_freeze" unless Storable::is_storing;
53 return (freeze(\@x), $self);
60 die "STORABLE_thaw #1" unless $obj eq $self;
63 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
64 die "STORABLE_thaw #3" unless @$a == 2 && $a->[0] eq 'a' && $a->[1] == 1;
66 die "STORABLE_thaw #4" unless Storable::is_retrieving;
73 sub make { bless {}, shift }
79 return ("", \@x, $self);
84 my ($cloning, $undef, $a, $obj) = @_;
85 die "STORABLE_thaw #1" unless $obj eq $self;
86 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY' || @$a != 2;
92 use Storable qw(dclone);
95 my $self = bless {}, shift;
97 $self->{sync} = OBJ_SYNC->make;
102 sub STORABLE_freeze {
106 my $t = dclone($r->{sync});
107 return ("", [$t, $self->{ext}], $r, $self, $r->{ext});
112 my ($cloning, $undef, $a, $r, $obj, $ext) = @_;
113 die "STORABLE_thaw #1" unless $obj eq $self;
114 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
115 die "STORABLE_thaw #3" unless ref $r eq 'HASH';
116 die "STORABLE_thaw #4" unless $a->[1] == $r->{ext};
118 ($self->{sync}, $self->{ext}) = @$a;
123 use Storable qw(freeze thaw);
129 sub make { bless [], shift }
131 sub STORABLE_freeze {
134 return (freeze($self), $self) if ++$recursed < $MAX;
135 return ("no", $self);
142 die "STORABLE_thaw #1" unless $obj eq $self;
143 $self->[0] = thaw($x) if $x ne "no";
149 my $real = OBJ_REAL->make;
150 my $x = freeze $real;
155 ok 3, $y->[0] eq 'a';
158 my $sync = OBJ_SYNC->make;
164 ok 7, $y->{ok} == $y;
167 $sync = OBJ_SYNC2->make($ext);
168 $x = freeze [$sync, $ext];
174 ok 10, $y->{ok} == $y;
175 ok 11, ref $y->{sync} eq 'OBJ_SYNC';
176 ok 12, $y->{ext} == $z->[1];
178 $real = OBJ_REAL2->make;
181 ok 14, $OBJ_REAL2::recursed == $OBJ_REAL2::MAX;
182 ok 15, $OBJ_REAL2::hook_called == $OBJ_REAL2::MAX;
186 ok 17, $OBJ_REAL2::recursed == 0;
190 ok 19, ref $x eq 'OBJ_REAL2';
191 ok 20, $OBJ_REAL2::recursed == 0;
192 ok 21, $OBJ_REAL2::hook_called == 2 * $OBJ_REAL2::MAX;
194 ok 22, !Storable::is_storing;
195 ok 23, !Storable::is_retrieving;
198 # The following was a test-case that Salvador Ortiz Garcia <sog@msg.com.mx>
199 # sent me, along with a proposed fix.
207 return bless {dat => $dat}, $class;
217 Foo->new(2), # Second instance of a Foo
222 sub STORABLE_freeze {
223 my($self,$clonning) = @_;
224 return "$self->{a}", $self->{b};
228 my($self,$clonning,$dummy,$o) = @_;
236 my $bar2 = thaw freeze $bar;
238 ok 24, ref($bar2) eq 'Bar';
239 ok 25, ref($bar->{b}[0]) eq 'Foo';
240 ok 26, ref($bar->{b}[1]) eq 'Foo';
241 ok 27, ref($bar2->{b}[0]) eq 'Foo';
242 ok 28, ref($bar2->{b}[1]) eq 'Foo';