1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
}
use strict;
my (@ary, %ary, %hash);
plan 88;
ok !defined($a);
$a = 1+1;
ok defined($a);
undef $a;
ok !defined($a);
$a = "hi";
ok defined($a);
$a = $b;
ok !defined($a);
@ary = ("1arg");
$a = pop(@ary);
ok defined($a);
$a = pop(@ary);
ok !defined($a);
@ary = ("1arg");
$a = shift(@ary);
ok defined($a);
$a = shift(@ary);
ok !defined($a);
$ary{'foo'} = 'hi';
ok defined($ary{'foo'});
ok !defined($ary{'bar'});
undef $ary{'foo'};
ok !defined($ary{'foo'});
sub foo { pass; 1 }
&foo || fail;
ok defined &foo;
undef &foo;
ok !defined(&foo);
eval { undef $1 };
like $@, qr/^Modification of a read/;
eval { $1 = undef };
like $@, qr/^Modification of a read/;
{
# [perl #17753] segfault when undef'ing unquoted string constant
eval 'undef tcp';
like $@, qr/^Can't modify constant item/;
}
# bugid 3096
# undefing a hash may free objects with destructors that then try to
# modify the hash. Ensure that the hash remains consistent
{
my (%hash, %mirror);
my $iters = 5;
for (1..$iters) {
$hash{"k$_"} = bless ["k$_"], 'X';
$mirror{"k$_"} = "k$_";
}
my $c = $iters;
my $events;
sub X::DESTROY {
my $key = $_[0][0];
$events .= 'D';
note("----- DELETE($key) ------");
delete $mirror{$key};
is join('-', sort keys %hash), join('-', sort keys %mirror),
"$key: keys";
is join('-', sort map $_->[0], values %hash),
join('-', sort values %mirror), "$key: values";
# don't know exactly what we'll get from the iterator, but
# it must be a sensible value
my ($k, $v) = each %hash;
ok defined $k ? exists($mirror{$k}) : (keys(%mirror) == 0),
"$key: each 1";
is delete $hash{$key}, undef, "$key: delete";
($k, $v) = each %hash;
ok defined $k ? exists($mirror{$k}) : (keys(%mirror) <= 1),
"$key: each 2";
$c++;
if ($c <= $iters * 2) {
$hash{"k$c"} = bless ["k$c"], 'X';
$mirror{"k$c"} = "k$c";
}
$events .= 'E';
}
each %hash; # set eiter
undef %hash;
is scalar keys %hash, 0, "hash empty at end";
is $events, ('DE' x ($iters*2)), "events";
my ($k, $v) = each %hash;
is $k, undef, 'each undef at end';
}
# part of #105906: inlined undef constant getting copied
BEGIN { $::{z} = \undef }
for (z,z) {
push @_, \$_;
}
is $_[0], $_[1], 'undef constants preserve identity';
# [perl #122556]
my $messages;
package Thingie;
DESTROY { $messages .= 'destroyed ' }
package main;
sub body {
sub {
my $t = bless [], 'Thingie';
undef $t;
}->(), $messages .= 'after ';
return;
}
body();
is $messages, 'destroyed after ', 'undef $scalar frees refs immediately';
# this will segfault if it fails
sub PVBM () { 'foo' }
{ my $dummy = index 'foo', PVBM }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
# Prior to GH#20077 (Add OPpTARGET_MY optimization to OP_UNDEF), any PV
# allocation was kept with "$x = undef" but freed with "undef $x". That
# behaviour was carried over and is expected to still be present.
# (I totally copied most of this block from other t/op/* files.)
SKIP: {
skip_without_dynamic_extension("Devel::Peek", 2);
my $out = runperl(stderr => 1,
progs => [ split /\n/, <<'EOS' ]);
require Devel::Peek;
my $f = q(x) x 40;
chop $f; # Make sure that the PV buffer is not COWed
$f = undef;
Devel::Peek::Dump($f);
undef $f;
Devel::Peek::Dump($f);
EOS
my ($space, $first, $second) = split /SV =/, $out;
like($first, qr/\bPV = 0x[0-9a-f]+\b/, '$x = undef preserves PV allocation');
like($second, qr/\bPV = 0\b$/, 'undef $x frees PV allocation');
}
# Tests suggested for GH#20077 (Add OPpTARGET_MY optimization to OP_UNDEF)
# (No failures were observed during development, these are just checking
# that no failures are introduced down the line.)
{
my $y= 1; my @x= ($y= undef);
is( defined($x[0]), "", 'lval undef assignment in list context');
is( defined($y) , "", 'scalar undef assignment in list context');
$y= 1; my $z; sub f{$z = shift} f($y=undef);
is( defined($y) , "", 'undef assignment in sub args');
is( defined($z) , "", 'undef assignment reaches @_');
($y,$z)=(1,2); sub f{} f(($y=undef),$z);
is( defined($y) , "", 'undef assignment reaches @_');
is( $z, 2, 'undef adjacent argument is unchanged');
}
{
my $h= { baz => 1 }; my @k= keys %{($h=undef)||{}};
is( defined($h) , "", 'scalar undef assignment in keys');
is( scalar @k, 0, 'undef assignment dor anonhash');
my $y= 1; my @x= \($y= undef);
is( defined($y) , "", 'scalar undef assignment before reference');
is( scalar @x, 1, 'assignment of one element to array');
is( defined($x[0]->$*), "", 'assignment of undef element to array');
}
# GH#20336 - "my $x = undef" pushed &PL_sv_undef onto the stack, but
# should be pushing $x (i.e. a mutable copy of &PL_sv_undef)
is( ++(my $x = undef), 1, '"my $x = undef" pushes $x onto the stack' );
|
