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 85;
  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 # this will segfault if it fails
 172
 173 sub PVBM () { 'foo' }
 174 { my $dummy = index 'foo', PVBM }
 175
 176 my $pvbm = PVBM;
 177 undef $pvbm;
 178 ok !defined $pvbm;