t/op/hash.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 use strict;
  10
  11 plan tests => 10;
  12
  13 # This will crash perl if it fails
  14
  15 use constant PVBM => 'foo';
  16
  17 my $dummy = index 'foo', PVBM;
  18 eval { my %h = (a => PVBM); 1 };
  19
  20 ok (!$@, 'fbm scalar can be inserted into a hash');
  21
  22
  23 my $destroyed;
  24 { package Class; DESTROY { ++$destroyed; } }
  25
  26 $destroyed = 0;
  27 {
  28     my %h;
  29     keys(%h) = 1;
  30     $h{key} = bless({}, 'Class');
  31 }
  32 is($destroyed, 1, 'Timely hash destruction with lvalue keys');
  33
  34
  35 # [perl #79178] Hash keys must not be stringified during compilation
  36 # Run perl -MO=Concise -e '$a{\"foo"}' on a non-threaded pre-5.13.8 version
  37 # to see why.
  38 {
  39     my $key;
  40     package bar;
  41     sub TIEHASH { bless {}, $_[0] }
  42     sub FETCH { $key = $_[1] }
  43     package main;
  44     tie my %h, "bar";
  45     () = $h{\'foo'};
  46     is ref $key, SCALAR =>
  47      'hash keys are not stringified during compilation';
  48 }
  49
  50 # Part of RT #85026: Deleting the current iterator in void context does not
  51 # free it.
  52 {
  53     my $gone;
  54     no warnings 'once';
  55     local *::DESTROY = sub { ++$gone };
  56     my %a=(a=>bless[]);
  57     each %a;   # make the entry with the obj the current iterator
  58     delete $a{a};
  59     ok $gone, 'deleting the current iterator in void context frees the val'
  60 }
  61
  62 # [perl #99660] Deleted hash element visible to destructor
  63 {
  64     my %h;
  65     $h{k} = bless [];
  66     my $normal_exit;
  67     local *::DESTROY = sub { my $x = $h{k}; ++$normal_exit };
  68     delete $h{k}; # must be in void context to trigger the bug
  69     ok $normal_exit, 'freed hash elems are not visible to DESTROY';
  70 }
  71
  72 # [perl #100340] Similar bug: freeing a hash elem during a delete
  73 sub guard::DESTROY {
  74    ${$_[0]}->();
  75 };
  76 *guard = sub (&) {
  77    my $callback = shift;
  78    return bless \$callback, "guard"
  79 };
  80 {
  81   my $ok;
  82   my %t; %t = (
  83     stash => {
  84         guard => guard(sub{
  85             $ok++;
  86             delete $t{stash};
  87         }),
  88         foo => "bar",
  89         bar => "baz",
  90     },
  91   );
  92   ok eval { delete $t{stash}{guard}; # must be in void context
  93             1 },
  94     'freeing a hash elem from destructor called by delete does not die';
  95   diag $@ if $@; # panic: free from wrong pool
  96   is $ok, 1, 'the destructor was called';
  97 }
  98
  99 # Weak references to pad hashes
 100 SKIP: {
 101     skip_if_miniperl("No Scalar::Util::weaken under miniperl", 1);
 102     my $ref;
 103     require Scalar::Util;
 104     {
 105         my %hash;
 106         Scalar::Util::weaken($ref = \%hash);
 107         1;  # the previous statement must not be the last
 108     }
 109     is $ref, undef, 'weak refs to pad hashes go stale on scope exit';
 110 }
 111
 112 # [perl #107440]
 113 sub A::DESTROY { $::ra = 0 }
 114 $::ra = {a=>bless [], 'A'};
 115 undef %$::ra;
 116 pass 'no crash when freeing hash that is being undeffed';
 117 $::ra = {a=>bless [], 'A'};
 118 %$::ra = ('a'..'z');
 119 pass 'no crash when freeing hash that is being exonerated, ahem, cleared';