This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d7d78c080625c3d61422614cc457f01c44aefa4e
[perl5.git] / t / op / undef.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10
11 use vars qw(@ary %ary %hash);
12
13 plan 86;
14
15 ok !defined($a);
16
17 $a = 1+1;
18 ok defined($a);
19
20 undef $a;
21 ok !defined($a);
22
23 $a = "hi";
24 ok defined($a);
25
26 $a = $b;
27 ok !defined($a);
28
29 @ary = ("1arg");
30 $a = pop(@ary);
31 ok defined($a);
32 $a = pop(@ary);
33 ok !defined($a);
34
35 @ary = ("1arg");
36 $a = shift(@ary);
37 ok defined($a);
38 $a = shift(@ary);
39 ok !defined($a);
40
41 $ary{'foo'} = 'hi';
42 ok defined($ary{'foo'});
43 ok !defined($ary{'bar'});
44 undef $ary{'foo'};
45 ok !defined($ary{'foo'});
46
47 {
48     no warnings 'deprecated';
49     ok defined(@ary);
50     ok defined(%ary);
51 }
52 ok %ary;
53 undef @ary;
54 {
55     no warnings 'deprecated';
56     ok !defined(@ary);
57 }
58 undef %ary;
59 {
60     no warnings 'deprecated';
61     ok !defined(%ary);
62 }
63 ok !%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 }
74 ok %ary;
75
76 sub foo { pass; 1 }
77
78 &foo || fail;
79
80 ok defined &foo;
81 undef &foo;
82 ok !defined(&foo);
83
84 eval { undef $1 };
85 like $@, qr/^Modification of a read/;
86
87 eval { $1 = undef };
88 like $@, 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
172 BEGIN { $::{z} = \undef }
173 for (z,z) {
174     push @_, \$_;
175 }
176 is $_[0], $_[1], 'undef constants preserve identity';
177
178 # this will segfault if it fails
179
180 sub PVBM () { 'foo' }
181 { my $dummy = index 'foo', PVBM }
182
183 my $pvbm = PVBM;
184 undef $pvbm;
185 ok !defined $pvbm;