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