1#!./perl
2
3use strict;
4use warnings;
5
6use Config;
7
8use Scalar::Util qw(weaken unweaken isweak);
9use Test::More tests => 28;
10
11# two references, one is weakened, the other is then undef'ed.
12{
13  my ($y,$z);
14
15  {
16    my $x = "foo";
17    $y = \$x;
18    $z = \$x;
19  }
20
21  ok(ref($y) and ref($z));
22
23  weaken($y);
24  ok(ref($y) and ref($z));
25
26  undef($z);
27  ok(not(defined($y) and defined($z)));
28
29  undef($y);
30  ok(not(defined($y) and defined($z)));
31}
32
33# one reference, which is weakened
34{
35  my $y;
36
37  {
38    my $x = "foo";
39    $y = \$x;
40  }
41
42  ok(ref($y));
43
44  weaken($y);
45  ok(not defined $y);
46}
47
48my $flag;
49
50# a circular structure
51{
52  $flag = 0;
53
54  {
55    my $y = bless {}, 'Dest';
56    $y->{Self} = $y;
57    $y->{Flag} = \$flag;
58
59    weaken($y->{Self});
60    ok( ref($y) );
61  }
62
63  ok( $flag == 1 );
64  undef $flag;
65}
66
67# a more complicated circular structure
68{
69  $flag = 0;
70
71  {
72    my $y = bless {}, 'Dest';
73    my $x = bless {}, 'Dest';
74    $x->{Ref} = $y;
75    $y->{Ref} = $x;
76    $x->{Flag} = \$flag;
77    $y->{Flag} = \$flag;
78
79    weaken($x->{Ref});
80  }
81  ok( $flag == 2 );
82}
83
84# deleting a weakref before the other one
85{
86  my ($y,$z);
87  {
88    my $x = "foo";
89    $y = \$x;
90    $z = \$x;
91  }
92
93  weaken($y);
94  undef($y);
95
96  ok(not defined $y);
97  ok(ref($z) );
98}
99
100# isweakref
101{
102  $a = 5;
103  ok(!isweak($a));
104  $b = \$a;
105  ok(!isweak($b));
106  weaken($b);
107  ok(isweak($b));
108  $b = \$a;
109  ok(!isweak($b));
110
111  my $x = {};
112  weaken($x->{Y} = \$a);
113  ok(isweak($x->{Y}));
114  ok(!isweak($x->{Z}));
115}
116
117# unweaken
118{
119  my ($y,$z);
120  {
121    my $x = "foo";
122    $y = \$x;
123    $z = \$x;
124  }
125
126  weaken($y);
127
128  ok(isweak($y), '$y is weak after weaken()');
129  is($$y, "foo", '$y points at \"foo" after weaken()');
130
131  unweaken($y);
132
133  is(ref $y, "SCALAR", '$y is still a SCALAR ref after unweaken()');
134  ok(!isweak($y), '$y is not weak after unweaken()');
135  is($$y, "foo", '$y points at \"foo" after unweaken()');
136
137  undef $z;
138  ok(defined $y, '$y still defined after undef $z');
139}
140
141# test weaken on a read only ref
142SKIP: {
143  # Doesn't work for older perls, see bug [perl #24506]
144  skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
145
146  # in a MAD build, constants have refcnt 2, not 1
147  skip("Test does not work with MAD", 5) if exists $Config{mad};
148
149  $a = eval '\"hello"';
150  ok(ref($a)) or print "# didn't get a ref from eval\n";
151
152  $b = $a;
153  eval { weaken($b) };
154  # we didn't die
155  is($@, "");
156  ok(isweak($b));
157  is($$b, "hello");
158
159  $a="";
160  ok(not $b) or diag("b did not go away");
161}
162
163package Dest;
164
165sub DESTROY {
166  ${$_[0]{Flag}} ++;
167}
168