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