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 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;