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