xref: /openbsd-src/gnu/usr.bin/perl/t/op/undef.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c)
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9use strict;
10
11use vars qw(@ary %ary %hash);
12
13plan 86;
14
15ok !defined($a);
16
17$a = 1+1;
18ok defined($a);
19
20undef $a;
21ok !defined($a);
22
23$a = "hi";
24ok defined($a);
25
26$a = $b;
27ok !defined($a);
28
29@ary = ("1arg");
30$a = pop(@ary);
31ok defined($a);
32$a = pop(@ary);
33ok !defined($a);
34
35@ary = ("1arg");
36$a = shift(@ary);
37ok defined($a);
38$a = shift(@ary);
39ok !defined($a);
40
41$ary{'foo'} = 'hi';
42ok defined($ary{'foo'});
43ok !defined($ary{'bar'});
44undef $ary{'foo'};
45ok !defined($ary{'foo'});
46
47{
48    no warnings 'deprecated';
49    ok defined(@ary);
50    ok defined(%ary);
51}
52ok %ary;
53undef @ary;
54{
55    no warnings 'deprecated';
56    ok !defined(@ary);
57}
58undef %ary;
59{
60    no warnings 'deprecated';
61    ok !defined(%ary);
62}
63ok !%ary;
64@ary = (1);
65{
66    no warnings 'deprecated';
67    ok defined @ary;
68}
69%ary = (1,1);
70{
71    no warnings 'deprecated';
72    ok defined %ary;
73}
74ok %ary;
75
76sub foo { pass; 1 }
77
78&foo || fail;
79
80ok defined &foo;
81undef &foo;
82ok !defined(&foo);
83
84eval { undef $1 };
85like $@, qr/^Modification of a read/;
86
87eval { $1 = undef };
88like $@, qr/^Modification of a read/;
89
90{
91    require Tie::Hash;
92    tie my %foo, 'Tie::StdHash';
93    no warnings 'deprecated';
94    ok defined %foo;
95    %foo = ( a => 1 );
96    ok defined %foo;
97}
98
99{
100    require Tie::Array;
101    tie my @foo, 'Tie::StdArray';
102    no warnings 'deprecated';
103    ok defined @foo;
104    @foo = ( a => 1 );
105    ok defined @foo;
106}
107
108{
109    # [perl #17753] segfault when undef'ing unquoted string constant
110    eval 'undef tcp';
111    like $@, qr/^Can't modify constant item/;
112}
113
114# bugid 3096
115# undefing a hash may free objects with destructors that then try to
116# modify the hash. Ensure that the hash remains consistent
117
118{
119    my (%hash, %mirror);
120
121    my $iters = 5;
122
123    for (1..$iters) {
124	$hash{"k$_"} = bless ["k$_"], 'X';
125	$mirror{"k$_"} = "k$_";
126    }
127
128
129    my $c = $iters;
130    my $events;
131
132    sub X::DESTROY {
133	my $key = $_[0][0];
134	$events .= 'D';
135	note("----- DELETE($key) ------");
136	delete $mirror{$key};
137
138	is join('-', sort keys %hash), join('-', sort keys %mirror),
139	    "$key: keys";
140	is join('-', sort map $_->[0], values %hash),
141	    join('-', sort values %mirror), "$key: values";
142
143	# don't know exactly what we'll get from the iterator, but
144	# it must be a sensible value
145	my ($k, $v) = each %hash;
146	ok defined $k ? exists($mirror{$k}) : (keys(%mirror) == 0),
147	    "$key: each 1";
148
149	is delete $hash{$key}, undef, "$key: delete";
150	($k, $v) = each %hash;
151	ok defined $k ? exists($mirror{$k}) : (keys(%mirror) <= 1),
152	    "$key: each 2";
153
154	$c++;
155	if ($c <= $iters * 2) {
156	    $hash{"k$c"} = bless ["k$c"], 'X';
157	    $mirror{"k$c"} = "k$c";
158	}
159	$events .= 'E';
160    }
161
162    each %hash; # set eiter
163    undef %hash;
164
165    is scalar keys %hash, 0, "hash empty at end";
166    is $events, ('DE' x ($iters*2)), "events";
167    my ($k, $v) = each %hash;
168    is $k, undef, 'each undef at end';
169}
170
171# part of #105906: inlined undef constant getting copied
172BEGIN { $::{z} = \undef }
173for (z,z) {
174    push @_, \$_;
175}
176is $_[0], $_[1], 'undef constants preserve identity';
177
178# this will segfault if it fails
179
180sub PVBM () { 'foo' }
181{ my $dummy = index 'foo', PVBM }
182
183my $pvbm = PVBM;
184undef $pvbm;
185ok !defined $pvbm;
186