Add 5.29.8 release to pod/perlhist
[perl.git] / t / op / undef.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use strict;
10
11 my (@ary, %ary, %hash);
12
13 plan 74;
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 sub foo { pass; 1 }
48
49 &foo || fail;
50
51 ok defined &foo;
52 undef &foo;
53 ok !defined(&foo);
54
55 eval { undef $1 };
56 like $@, qr/^Modification of a read/;
57
58 eval { $1 = undef };
59 like $@, qr/^Modification of a read/;
60
61 {
62     # [perl #17753] segfault when undef'ing unquoted string constant
63     eval 'undef tcp';
64     like $@, qr/^Can't modify constant item/;
65 }
66
67 # bugid 3096
68 # undefing a hash may free objects with destructors that then try to
69 # modify the hash. Ensure that the hash remains consistent
70
71 {
72     my (%hash, %mirror);
73
74     my $iters = 5;
75
76     for (1..$iters) {
77         $hash{"k$_"} = bless ["k$_"], 'X';
78         $mirror{"k$_"} = "k$_";
79     }
80
81
82     my $c = $iters;
83     my $events;
84
85     sub X::DESTROY {
86         my $key = $_[0][0];
87         $events .= 'D';
88         note("----- DELETE($key) ------");
89         delete $mirror{$key};
90
91         is join('-', sort keys %hash), join('-', sort keys %mirror),
92             "$key: keys";
93         is join('-', sort map $_->[0], values %hash),
94             join('-', sort values %mirror), "$key: values";
95
96         # don't know exactly what we'll get from the iterator, but
97         # it must be a sensible value
98         my ($k, $v) = each %hash;
99         ok defined $k ? exists($mirror{$k}) : (keys(%mirror) == 0),
100             "$key: each 1";
101
102         is delete $hash{$key}, undef, "$key: delete";
103         ($k, $v) = each %hash;
104         ok defined $k ? exists($mirror{$k}) : (keys(%mirror) <= 1),
105             "$key: each 2";
106
107         $c++;
108         if ($c <= $iters * 2) {
109             $hash{"k$c"} = bless ["k$c"], 'X';
110             $mirror{"k$c"} = "k$c";
111         }
112         $events .= 'E';
113     }
114
115     each %hash; # set eiter
116     undef %hash;
117
118     is scalar keys %hash, 0, "hash empty at end";
119     is $events, ('DE' x ($iters*2)), "events";
120     my ($k, $v) = each %hash;
121     is $k, undef, 'each undef at end';
122 }
123
124 # part of #105906: inlined undef constant getting copied
125 BEGIN { $::{z} = \undef }
126 for (z,z) {
127     push @_, \$_;
128 }
129 is $_[0], $_[1], 'undef constants preserve identity';
130
131 # [perl #122556]
132 my $messages;
133 package Thingie;
134 DESTROY { $messages .= 'destroyed ' }
135 package main;
136 sub body {
137     sub {
138         my $t = bless [], 'Thingie';
139         undef $t;
140     }->(), $messages .= 'after ';
141
142     return;
143 }
144 body();
145 is $messages, 'destroyed after ', 'undef $scalar frees refs immediately';
146
147
148 # this will segfault if it fails
149
150 sub PVBM () { 'foo' }
151 { my $dummy = index 'foo', PVBM }
152
153 my $pvbm = PVBM;
154 undef $pvbm;
155 ok !defined $pvbm;