xref: /openbsd/gnu/usr.bin/perl/dist/Storable/t/weak.t (revision 3d8817e4) 
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  # This lets us distribute Test::More in t/
11  unshift @INC, 't';
12  require Config; import Config;
13  if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
14    print "1..0 # Skip: Storable was not built\n";
15    exit 0;
16  }
17  if ($Config{extensions} !~ /\bList\/Util\b/) {
18    print "1..0 # Skip: List::Util was not built\n";
19    exit 0;
20  }
21
22  require Scalar::Util;
23  Scalar::Util->import(qw(weaken isweak));
24  if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
25    print("1..0 # Skip: No support for weaken in Scalar::Util\n");
26    exit 0;
27  }
28}
29
30use Test::More 'no_plan';
31use Storable qw (store retrieve freeze thaw nstore nfreeze);
32require 'testlib.pl';
33use vars '$file';
34use strict;
35
36sub tester {
37  my ($contents, $sub, $testersub, $what) = @_;
38  # Test that if we re-write it, everything still works:
39  my $clone = &$sub ($contents);
40  is ($@, "", "There should be no error extracting for $what");
41  &$testersub ($clone, $what);
42}
43
44my $r = {};
45my $s1 = [$r, $r];
46weaken $s1->[1];
47ok (isweak($s1->[1]), "element 1 is a weak reference");
48
49my $s0 = [$r, $r];
50weaken $s0->[0];
51ok (isweak($s0->[0]), "element 0 is a weak reference");
52
53my $w = [$r];
54weaken $w->[0];
55ok (isweak($w->[0]), "element 0 is a weak reference");
56
57package OVERLOADED;
58
59use overload
60	'""' => sub { $_[0][0] };
61
62package main;
63
64$a = bless [77], 'OVERLOADED';
65
66my $o = [$a, $a];
67weaken $o->[0];
68ok (isweak($o->[0]), "element 0 is a weak reference");
69
70my @tests = (
71[$s1,
72 sub  {
73  my ($clone, $what) = @_;
74  isa_ok($clone,'ARRAY');
75  isa_ok($clone->[0],'HASH');
76  isa_ok($clone->[1],'HASH');
77  ok(!isweak $clone->[0], "Element 0 isn't weak");
78  ok(isweak $clone->[1], "Element 1 is weak");
79}
80],
81# The weak reference needs to hang around long enough for other stuff to
82# be able to make references to it. So try it second.
83[$s0,
84 sub  {
85  my ($clone, $what) = @_;
86  isa_ok($clone,'ARRAY');
87  isa_ok($clone->[0],'HASH');
88  isa_ok($clone->[1],'HASH');
89  ok(isweak $clone->[0], "Element 0 is weak");
90  ok(!isweak $clone->[1], "Element 1 isn't weak");
91}
92],
93[$w,
94 sub  {
95  my ($clone, $what) = @_;
96  isa_ok($clone,'ARRAY');
97  if ($what eq 'nothing') {
98    # We're the original, so we're still a weakref to a hash
99    isa_ok($clone->[0],'HASH');
100    ok(isweak $clone->[0], "Element 0 is weak");
101  } else {
102    is($clone->[0],undef);
103  }
104}
105],
106[$o,
107sub {
108  my ($clone, $what) = @_;
109  isa_ok($clone,'ARRAY');
110  isa_ok($clone->[0],'OVERLOADED');
111  isa_ok($clone->[1],'OVERLOADED');
112  ok(isweak $clone->[0], "Element 0 is weak");
113  ok(!isweak $clone->[1], "Element 1 isn't weak");
114  is ("$clone->[0]", 77, "Element 0 stringifies to 77");
115  is ("$clone->[1]", 77, "Element 1 stringifies to 77");
116}
117],
118);
119
120foreach (@tests) {
121  my ($input, $testsub) = @$_;
122
123  tester($input, sub {return shift}, $testsub, 'nothing');
124
125  ok (defined store($input, $file));
126
127  # Read the contents into memory:
128  my $contents = slurp ($file);
129
130  tester($contents, \&store_and_retrieve, $testsub, 'file');
131
132  # And now try almost everything again with a Storable string
133  my $stored = freeze $input;
134  tester($stored, \&freeze_and_thaw, $testsub, 'string');
135
136  ok (defined nstore($input, $file));
137
138  tester($contents, \&store_and_retrieve, $testsub, 'network file');
139
140  $stored = nfreeze $input;
141  tester($stored, \&freeze_and_thaw, $testsub, 'network string');
142}
143