3 # Copyright 2004, Larry Wall.
5 # You may redistribute only under the same terms as Perl 5, as specified
6 # in the README file that comes with the distribution.
12 @INC = ('.', '../lib', '../ext/Storable/t');
14 # This lets us distribute Test::More in t/
17 require Config; import Config;
18 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
19 print "1..0 # Skip: Storable was not built\n";
22 if ($Config{extensions} !~ /\bList\/Util\b/) {
23 print "1..0 # Skip: List::Util was not built\n";
28 Scalar::Util->import(qw(weaken isweak));
29 if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
30 print("1..0 # Skip: No support for weaken in Scalar::Util\n");
35 use Test::More 'no_plan';
36 use Storable qw (store retrieve freeze thaw nstore nfreeze);
42 my ($contents, $sub, $testersub, $what) = @_;
43 # Test that if we re-write it, everything still works:
44 my $clone = &$sub ($contents);
45 is ($@, "", "There should be no error extracting for $what");
46 &$testersub ($clone, $what);
52 ok (isweak($s1->[1]), "element 1 is a weak reference");
56 ok (isweak($s0->[0]), "element 0 is a weak reference");
60 ok (isweak($w->[0]), "element 0 is a weak reference");
65 '""' => sub { $_[0][0] };
69 $a = bless [77], 'OVERLOADED';
73 ok (isweak($o->[0]), "element 0 is a weak reference");
78 my ($clone, $what) = @_;
79 isa_ok($clone,'ARRAY');
80 isa_ok($clone->[0],'HASH');
81 isa_ok($clone->[1],'HASH');
82 ok(!isweak $clone->[0], "Element 0 isn't weak");
83 ok(isweak $clone->[1], "Element 1 is weak");
86 # The weak reference needs to hang around long enough for other stuff to
87 # be able to make references to it. So try it second.
90 my ($clone, $what) = @_;
91 isa_ok($clone,'ARRAY');
92 isa_ok($clone->[0],'HASH');
93 isa_ok($clone->[1],'HASH');
94 ok(isweak $clone->[0], "Element 0 is weak");
95 ok(!isweak $clone->[1], "Element 1 isn't weak");
100 my ($clone, $what) = @_;
101 isa_ok($clone,'ARRAY');
102 if ($what eq 'nothing') {
103 # We're the original, so we're still a weakref to a hash
104 isa_ok($clone->[0],'HASH');
105 ok(isweak $clone->[0], "Element 0 is weak");
107 is($clone->[0],undef);
113 my ($clone, $what) = @_;
114 isa_ok($clone,'ARRAY');
115 isa_ok($clone->[0],'OVERLOADED');
116 isa_ok($clone->[1],'OVERLOADED');
117 ok(isweak $clone->[0], "Element 0 is weak");
118 ok(!isweak $clone->[1], "Element 1 isn't weak");
119 is ("$clone->[0]", 77, "Element 0 stringifies to 77");
120 is ("$clone->[1]", 77, "Element 1 stringifies to 77");
126 my ($input, $testsub) = @$_;
128 tester($input, sub {return shift}, $testsub, 'nothing');
130 ok (defined store($input, $file));
132 # Read the contents into memory:
133 my $contents = slurp ($file);
135 tester($contents, \&store_and_retrieve, $testsub, 'file');
137 # And now try almost everything again with a Storable string
138 my $stored = freeze $input;
139 tester($stored, \&freeze_and_thaw, $testsub, 'string');
141 ok (defined nstore($input, $file));
143 tester($contents, \&store_and_retrieve, $testsub, 'network file');
145 $stored = nfreeze $input;
146 tester($stored, \&freeze_and_thaw, $testsub, 'network string');