t/50-threads.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use autovivification::TestThreads;
   8
   9 use Test::Leaner;
  10
  11 my $threads = 10;
  12 my $runs    = 2;
  13
  14 {
  15  no autovivification;
  16
  17  sub try {
  18   my $tid = threads->tid();
  19
  20   for my $run (1 .. $runs) {
  21    {
  22     my $x;
  23     my $y = $x->{foo};
  24     is $x, undef, "fetch does not autovivify at thread $tid run $run";
  25    }
  26    {
  27     my $x;
  28     my $y = exists $x->{foo};
  29     is $x, undef, "exists does not autovivify at thread $tid run $run";
  30    }
  31    {
  32     my $x;
  33     my $y = delete $x->{foo};
  34     is $x, undef, "delete does not autovivify at thread $tid run $run";
  35    }
  36
  37 SKIP:
  38    {
  39     skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2
  40                                                            unless "$]" >= 5.010;
  41     {
  42      my $x;
  43      eval 'my $y = $x->{foo}';
  44      is $@, '',    "fetch in eval does not croak at thread $tid run $run";
  45      is $x, undef, "fetch in eval does not autovivify at thread $tid run $run";
  46     }
  47     {
  48      my $x;
  49      eval 'my $y = exists $x->{foo}';
  50      is $@, '',    "exists in eval does not croak at thread $tid run $run";
  51      is $x, undef, "exists in eval does not autovivify at thread $tid run $run";
  52     }
  53     {
  54      my $x;
  55      eval 'my $y = delete $x->{foo}';
  56      is $@, '',    "delete in eval does not croak at thread $tid run $run";
  57      is $x, undef, "delete in eval does not autovivify at thread $tid run $run";
  58     }
  59    }
  60   }
  61  }
  62 }
  63
  64 my @threads = map spawn(\&try), 1 .. $threads;
  65
  66 $_->join for @threads;
  67
  68 pass 'done';
  69
  70 done_testing(scalar(@threads) * $runs * 3 * (1 + 2) + 1);