Re: [PATCH] Enhanced Storable::read_magic()
[p5sagit/p5-mst-13.2.git] / ext / Storable / t / weak.t
CommitLineData
c3c53033 1#!./perl -w
2#
3# Copyright 2004, Larry Wall.
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
9sub BEGIN {
10 if ($ENV{PERL_CORE}){
11 chdir('t') if -d 't';
12 @INC = ('.', '../lib', '../ext/Storable/t');
13 } else {
14 # This lets us distribute Test::More in t/
15 unshift @INC, 't';
16 }
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";
20 exit 0;
21 }
22 if ($Config{extensions} !~ /\bList\/Util\b/) {
23 print "1..0 # Skip: List::Util was not built\n";
24 exit 0;
25 }
26
27 require Scalar::Util;
fac63a07 28 Scalar::Util->import(qw(weaken isweak));
c3c53033 29 if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
30 print("1..0 # Skip: No support for weaken in Scalar::Util\n");
31 exit 0;
32 }
33}
34
35use Test::More 'no_plan';
36use Storable qw (store retrieve freeze thaw nstore nfreeze);
37require 'testlib.pl';
38use vars '$file';
39use strict;
40
41sub tester {
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);
47}
48
49my $r = {};
50my $s1 = [$r, $r];
51weaken $s1->[1];
52ok (isweak($s1->[1]), "element 1 is a weak reference");
53
54my $s0 = [$r, $r];
55weaken $s0->[0];
56ok (isweak($s0->[0]), "element 0 is a weak reference");
57
58my $w = [$r];
59weaken $w->[0];
60ok (isweak($w->[0]), "element 0 is a weak reference");
61
62package OVERLOADED;
63
64use overload
65 '""' => sub { $_[0][0] };
66
67package main;
68
69$a = bless [77], 'OVERLOADED';
70
71my $o = [$a, $a];
72weaken $o->[0];
73ok (isweak($o->[0]), "element 0 is a weak reference");
74
75my @tests = (
76[$s1,
77 sub {
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");
84}
85],
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.
88[$s0,
89 sub {
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");
96}
97],
98[$w,
99 sub {
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");
106 } else {
107 is($clone->[0],undef);
108 }
109}
110],
111[$o,
112sub {
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");
121}
122],
123);
124
125foreach (@tests) {
126 my ($input, $testsub) = @$_;
127
128 tester($input, sub {return shift}, $testsub, 'nothing');
129
130 ok (defined store($input, $file));
131
132 # Read the contents into memory:
133 my $contents = slurp ($file);
134
135 tester($contents, \&store_and_retrieve, $testsub, 'file');
136
137 # And now try almost everything again with a Storable string
138 my $stored = freeze $input;
139 tester($stored, \&freeze_and_thaw, $testsub, 'string');
140
141 ok (defined nstore($input, $file));
142
143 tester($contents, \&store_and_retrieve, $testsub, 'network file');
144
145 $stored = nfreeze $input;
146 tester($stored, \&freeze_and_thaw, $testsub, 'network string');
147}