t/50-threads.t

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