1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9use strict; 10 11my (@ary, %ary, %hash); 12 13plan 88; 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 47sub foo { pass; 1 } 48 49&foo || fail; 50 51ok defined &foo; 52undef &foo; 53ok !defined(&foo); 54 55eval { undef $1 }; 56like $@, qr/^Modification of a read/; 57 58eval { $1 = undef }; 59like $@, 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 125BEGIN { $::{z} = \undef } 126for (z,z) { 127 push @_, \$_; 128} 129is $_[0], $_[1], 'undef constants preserve identity'; 130 131# [perl #122556] 132my $messages; 133package Thingie; 134DESTROY { $messages .= 'destroyed ' } 135package main; 136sub body { 137 sub { 138 my $t = bless [], 'Thingie'; 139 undef $t; 140 }->(), $messages .= 'after '; 141 142 return; 143} 144body(); 145is $messages, 'destroyed after ', 'undef $scalar frees refs immediately'; 146 147 148# this will segfault if it fails 149 150sub PVBM () { 'foo' } 151{ my $dummy = index 'foo', PVBM } 152 153my $pvbm = PVBM; 154undef $pvbm; 155ok !defined $pvbm; 156 157# Prior to GH#20077 (Add OPpTARGET_MY optimization to OP_UNDEF), any PV 158# allocation was kept with "$x = undef" but freed with "undef $x". That 159# behaviour was carried over and is expected to still be present. 160# (I totally copied most of this block from other t/op/* files.) 161 162SKIP: { 163 skip_without_dynamic_extension("Devel::Peek", 2); 164 165 my $out = runperl(stderr => 1, 166 progs => [ split /\n/, <<'EOS' ]); 167 require Devel::Peek; 168 my $f = q(x) x 40; $f = undef; 169 Devel::Peek::Dump($f); 170 undef $f; 171 Devel::Peek::Dump($f); 172EOS 173 174 my ($space, $first, $second) = split /SV =/, $out; 175 like($first, qr/\bPV = 0x[0-9a-f]+\b/, '$x = undef preserves PV allocation'); 176 like($second, qr/\bPV = 0\b$/, 'undef $x frees PV allocation'); 177} 178 179# Tests suggested for GH#20077 (Add OPpTARGET_MY optimization to OP_UNDEF) 180# (No failures were observed during development, these are just checking 181# that no failures are introduced down the line.) 182 183{ 184 my $y= 1; my @x= ($y= undef); 185 is( defined($x[0]), "", 'lval undef assignment in list context'); 186 is( defined($y) , "", 'scalar undef assignment in list context'); 187 188 $y= 1; my $z; sub f{$z = shift} f($y=undef); 189 is( defined($y) , "", 'undef assignment in sub args'); 190 is( defined($z) , "", 'undef assignment reaches @_'); 191 192 ($y,$z)=(1,2); sub f{} f(($y=undef),$z); 193 is( defined($y) , "", 'undef assignment reaches @_'); 194 is( $z, 2, 'undef adjacent argument is unchanged'); 195} 196 197{ 198 my $h= { baz => 1 }; my @k= keys %{($h=undef)||{}}; 199 is( defined($h) , "", 'scalar undef assignment in keys'); 200 is( scalar @k, 0, 'undef assignment dor anonhash'); 201 202 my $y= 1; my @x= \($y= undef); 203 is( defined($y) , "", 'scalar undef assignment before reference'); 204 is( scalar @x, 1, 'assignment of one element to array'); 205 is( defined($x[0]->$*), "", 'assignment of undef element to array'); 206} 207 208# GH#20336 - "my $x = undef" pushed &PL_sv_undef onto the stack, but 209# should be pushing $x (i.e. a mutable copy of &PL_sv_undef) 210is( ++(my $x = undef), 1, '"my $x = undef" pushes $x onto the stack' ); 211