xref: /openbsd-src/gnu/usr.bin/perl/cpan/Scalar-List-Utils/t/weak.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1#!./perl
2
3use strict;
4use Config;
5BEGIN {
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
17use Scalar::Util ();
18use Test::More  ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE})
19			? (skip_all => 'weaken requires XS version')
20			: (tests => 28);
21
22Scalar::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
61my $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  is(ref $y, "SCALAR", '$y is still a SCALAR ref after unweaken()');
147  ok(!isweak($y), '$y is not weak after unweaken()');
148  is($$y, "foo", '$y points at \"foo" after unweaken()');
149
150  undef $z;
151  ok(defined $y, '$y still defined after undef $z');
152}
153
154# test weaken on a read only ref
155SKIP: {
156  # Doesn't work for older perls, see bug [perl #24506]
157  skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
158
159  # in a MAD build, constants have refcnt 2, not 1
160  skip("Test does not work with MAD", 5) if exists $Config{mad};
161
162  $a = eval '\"hello"';
163  ok(ref($a)) or print "# didn't get a ref from eval\n";
164
165  $b = $a;
166  eval { weaken($b) };
167  # we didn't die
168  is($@, "");
169  ok(isweak($b));
170  is($$b, "hello");
171
172  $a="";
173  ok(not $b) or diag("b did not go away");
174}
175
176package Dest;
177
178sub DESTROY {
179  ${$_[0]{Flag}} ++;
180}
181