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