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 40; 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 47ok defined(@ary); 48{ 49 no warnings 'deprecated'; 50 ok defined(%ary); 51} 52ok %ary; 53undef @ary; 54ok !defined(@ary); 55undef %ary; 56{ 57 no warnings 'deprecated'; 58 ok !defined(%ary); 59} 60ok !%ary; 61@ary = (1); 62ok defined @ary; 63%ary = (1,1); 64{ 65 no warnings 'deprecated'; 66 ok defined %ary; 67} 68ok %ary; 69 70sub foo { pass; 1 } 71 72&foo || fail; 73 74ok defined &foo; 75undef &foo; 76ok !defined(&foo); 77 78eval { undef $1 }; 79like $@, qr/^Modification of a read/; 80 81eval { $1 = undef }; 82like $@, qr/^Modification of a read/; 83 84{ 85 require Tie::Hash; 86 tie my %foo, 'Tie::StdHash'; 87 no warnings 'deprecated'; 88 ok defined %foo; 89 %foo = ( a => 1 ); 90 ok defined %foo; 91} 92 93{ 94 require Tie::Array; 95 tie my @foo, 'Tie::StdArray'; 96 no warnings 'deprecated'; 97 ok defined @foo; 98 @foo = ( a => 1 ); 99 ok defined @foo; 100} 101 102{ 103 # [perl #17753] segfault when undef'ing unquoted string constant 104 eval 'undef tcp'; 105 like $@, qr/^Can't modify constant item/; 106} 107 108# bugid 3096 109# undefing a hash may free objects with destructors that then try to 110# modify the hash. To them, the hash should appear empty. 111 112%hash = ( 113 key1 => bless({}, 'X'), 114 key2 => bless({}, 'X'), 115); 116undef %hash; 117sub X::DESTROY { 118 is scalar keys %hash, 0; 119 is scalar values %hash, 0; 120 my @l = each %hash; 121 is @l, 0; 122 is delete $hash{'key2'}, undef; 123} 124 125# this will segfault if it fails 126 127sub PVBM () { 'foo' } 128{ my $dummy = index 'foo', PVBM } 129 130my $pvbm = PVBM; 131undef $pvbm; 132ok !defined $pvbm; 133