Commit | Line | Data |
1bfb5477 |
1 | #!./perl |
2 | |
2ff28616 |
3 | use strict; |
4 | use Config; |
f4a2945e |
5 | BEGIN { |
1bfb5477 |
6 | unless (-d 'blib') { |
f4a2945e |
7 | chdir 't' if -d 't'; |
8 | @INC = '../lib'; |
1bfb5477 |
9 | keys %Config; # Silence warning |
6b05f64e |
10 | if ($Config{extensions} !~ /\bList\/Util\b/) { |
11 | print "1..0 # Skip: List::Util was not built\n"; |
12 | exit 0; |
13 | } |
1bfb5477 |
14 | } |
f4a2945e |
15 | } |
16 | |
cf083cf9 |
17 | use Scalar::Util (); |
2ff28616 |
18 | use Test::More ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE}) |
cf083cf9 |
19 | ? (skip_all => 'weaken requires XS version') |
20 | : (tests => 22); |
21 | |
22 | if (0) { |
23 | require Devel::Peek; |
24 | Devel::Peek->import('Dump'); |
f4a2945e |
25 | } |
cf083cf9 |
26 | else { |
27 | *Dump = sub {}; |
f4a2945e |
28 | } |
29 | |
cf083cf9 |
30 | Scalar::Util->import(qw(weaken isweak)); |
f4a2945e |
31 | |
32 | if(1) { |
33 | |
34 | my ($y,$z); |
35 | |
36 | # |
37 | # Case 1: two references, one is weakened, the other is then undef'ed. |
38 | # |
39 | |
40 | { |
41 | my $x = "foo"; |
42 | $y = \$x; |
43 | $z = \$x; |
44 | } |
cf083cf9 |
45 | print "# START\n"; |
f4a2945e |
46 | Dump($y); Dump($z); |
47 | |
cf083cf9 |
48 | ok( ref($y) and ref($z)); |
f4a2945e |
49 | |
50 | print "# WEAK:\n"; |
cf083cf9 |
51 | weaken($y); |
f4a2945e |
52 | Dump($y); Dump($z); |
53 | |
cf083cf9 |
54 | ok( ref($y) and ref($z)); |
f4a2945e |
55 | |
56 | print "# UNDZ:\n"; |
cf083cf9 |
57 | undef($z); |
f4a2945e |
58 | Dump($y); Dump($z); |
59 | |
60 | ok( not (defined($y) and defined($z)) ); |
f4a2945e |
61 | |
62 | print "# UNDY:\n"; |
cf083cf9 |
63 | undef($y); |
f4a2945e |
64 | Dump($y); Dump($z); |
65 | |
66 | ok( not (defined($y) and defined($z)) ); |
67 | |
68 | print "# FIN:\n"; |
69 | Dump($y); Dump($z); |
70 | |
f4a2945e |
71 | |
72 | # |
73 | # Case 2: one reference, which is weakened |
74 | # |
75 | |
f4a2945e |
76 | print "# CASE 2:\n"; |
77 | |
78 | { |
79 | my $x = "foo"; |
80 | $y = \$x; |
81 | } |
82 | |
cf083cf9 |
83 | ok( ref($y) ); |
f4a2945e |
84 | print "# BW: \n"; |
85 | Dump($y); |
86 | weaken($y); |
87 | print "# AW: \n"; |
88 | Dump($y); |
89 | ok( not defined $y ); |
90 | |
91 | print "# EXITBLOCK\n"; |
92 | } |
93 | |
f4a2945e |
94 | # |
95 | # Case 3: a circular structure |
96 | # |
97 | |
2ff28616 |
98 | my $flag = 0; |
f4a2945e |
99 | { |
2ff28616 |
100 | my $y = bless {}, 'Dest'; |
f4a2945e |
101 | Dump($y); |
102 | print "# 1: $y\n"; |
103 | $y->{Self} = $y; |
104 | Dump($y); |
105 | print "# 2: $y\n"; |
106 | $y->{Flag} = \$flag; |
107 | print "# 3: $y\n"; |
108 | weaken($y->{Self}); |
109 | print "# WKED\n"; |
cf083cf9 |
110 | ok( ref($y) ); |
f4a2945e |
111 | print "# VALS: HASH ",$y," SELF ",\$y->{Self}," Y ",\$y, |
112 | " FLAG: ",\$y->{Flag},"\n"; |
113 | print "# VPRINT\n"; |
114 | } |
115 | print "# OUT $flag\n"; |
116 | ok( $flag == 1 ); |
117 | |
118 | print "# AFTER\n"; |
119 | |
120 | undef $flag; |
121 | |
122 | print "# FLAGU\n"; |
123 | |
124 | # |
125 | # Case 4: a more complicated circular structure |
126 | # |
127 | |
128 | $flag = 0; |
129 | { |
2ff28616 |
130 | my $y = bless {}, 'Dest'; |
131 | my $x = bless {}, 'Dest'; |
f4a2945e |
132 | $x->{Ref} = $y; |
133 | $y->{Ref} = $x; |
134 | $x->{Flag} = \$flag; |
135 | $y->{Flag} = \$flag; |
136 | weaken($x->{Ref}); |
137 | } |
138 | ok( $flag == 2 ); |
139 | |
140 | # |
141 | # Case 5: deleting a weakref before the other one |
142 | # |
143 | |
2ff28616 |
144 | my ($y,$z); |
f4a2945e |
145 | { |
146 | my $x = "foo"; |
147 | $y = \$x; |
148 | $z = \$x; |
149 | } |
150 | |
151 | print "# CASE5\n"; |
152 | Dump($y); |
153 | |
154 | weaken($y); |
155 | Dump($y); |
156 | undef($y); |
157 | |
158 | ok( not defined $y); |
cf083cf9 |
159 | ok( ref($z) ); |
f4a2945e |
160 | |
161 | |
162 | # |
163 | # Case 6: test isweakref |
164 | # |
165 | |
166 | $a = 5; |
167 | ok(!isweak($a)); |
168 | $b = \$a; |
169 | ok(!isweak($b)); |
170 | weaken($b); |
171 | ok(isweak($b)); |
172 | $b = \$a; |
173 | ok(!isweak($b)); |
174 | |
2ff28616 |
175 | my $x = {}; |
f4a2945e |
176 | weaken($x->{Y} = \$a); |
177 | ok(isweak($x->{Y})); |
178 | ok(!isweak($x->{Z})); |
179 | |
e6469971 |
180 | # |
181 | # Case 7: test weaken on a read only ref |
182 | # |
183 | |
cf083cf9 |
184 | SKIP: { |
e6469971 |
185 | # Doesn't work for older perls, see bug [perl #24506] |
cf083cf9 |
186 | skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003; |
187 | |
f8babb25 |
188 | # in a MAD build, constants have refcnt 2, not 1 |
189 | skip("Test does not work with MAD", 5) if exists $Config{mad}; |
190 | |
e6469971 |
191 | $a = eval '\"hello"'; |
192 | ok(ref($a)) or print "# didn't get a ref from eval\n"; |
193 | $b = $a; |
194 | eval{weaken($b)}; |
195 | # we didn't die |
196 | ok($@ eq "") or print "# died with $@\n"; |
197 | ok(isweak($b)); |
198 | ok($$b eq "hello") or print "# b is '$$b'\n"; |
199 | $a=""; |
200 | ok(not $b) or print "# b didn't go away\n"; |
201 | } |
f4a2945e |
202 | |
203 | package Dest; |
204 | |
205 | sub DESTROY { |
206 | print "# INCFLAG\n"; |
207 | ${$_[0]{Flag}} ++; |
208 | } |