3 # $Id: recurse.t,v 0.7 2000/08/03 22:04:45 ram Exp $
5 # Copyright (c) 1995-2000, Raphael Manfredi
7 # You may redistribute only under the terms of the Artistic License,
8 # as specified in the README file that comes with the distribution.
11 # Revision 0.7 2000/08/03 22:04:45 ram
12 # Baseline for second beta release.
17 unshift @INC, '../lib';
18 require Config; import Config;
19 if ($Config{'extensions'} !~ /\bStorable\b/) {
20 print "1..0 # Skip: Storable was not built\n";
23 require 'lib/st-dump.pl';
28 use Storable qw(freeze thaw dclone);
34 use Storable qw(freeze thaw);
38 sub make { bless [], shift }
43 die "STORABLE_freeze" unless Storable::is_storing;
44 return (freeze(\@x), $self);
51 die "STORABLE_thaw #1" unless $obj eq $self;
54 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
55 die "STORABLE_thaw #3" unless @$a == 2 && $a->[0] eq 'a' && $a->[1] == 1;
57 die "STORABLE_thaw #4" unless Storable::is_retrieving;
64 sub make { bless {}, shift }
70 return ("", \@x, $self);
75 my ($cloning, $undef, $a, $obj) = @_;
76 die "STORABLE_thaw #1" unless $obj eq $self;
77 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY' || @$a != 2;
83 use Storable qw(dclone);
86 my $self = bless {}, shift;
88 $self->{sync} = OBJ_SYNC->make;
95 my $t = dclone($self->{sync});
96 return ("", [$t, $self->{ext}], $self, $self->{ext});
101 my ($cloning, $undef, $a, $obj, $ext) = @_;
102 die "STORABLE_thaw #1" unless $obj eq $self;
103 die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
105 ($self->{sync}, $self->{ext}) = @$a;
110 use Storable qw(freeze thaw);
116 sub make { bless [], shift }
118 sub STORABLE_freeze {
121 return (freeze($self), $self) if ++$recursed < $MAX;
122 return ("no", $self);
129 die "STORABLE_thaw #1" unless $obj eq $self;
130 $self->[0] = thaw($x) if $x ne "no";
136 my $real = OBJ_REAL->make;
137 my $x = freeze $real;
142 ok 3, $y->[0] eq 'a';
145 my $sync = OBJ_SYNC->make;
151 ok 7, $y->{ok} == $y;
154 $sync = OBJ_SYNC2->make($ext);
155 $x = freeze [$sync, $ext];
161 ok 10, $y->{ok} == $y;
162 ok 11, ref $y->{sync} eq 'OBJ_SYNC';
163 ok 12, $y->{ext} == $z->[1];
165 $real = OBJ_REAL2->make;
168 ok 14, $OBJ_REAL2::recursed == $OBJ_REAL2::MAX;
169 ok 15, $OBJ_REAL2::hook_called == $OBJ_REAL2::MAX;
173 ok 17, $OBJ_REAL2::recursed == 0;
177 ok 19, ref $x eq 'OBJ_REAL2';
178 ok 20, $OBJ_REAL2::recursed == 0;
179 ok 21, $OBJ_REAL2::hook_called == 2 * $OBJ_REAL2::MAX;
181 ok 22, !Storable::is_storing;
182 ok 23, !Storable::is_retrieving;