t/50-threads.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config qw/%Config/;
   7
   8 BEGIN {
   9  if (!$Config{useithreads}) {
  10   require Test::More;
  11   Test::More->import;
  12   plan(skip_all => 'This perl wasn\'t built to support threads');
  13  }
  14 }
  15
  16 use threads;
  17
  18 use Test::More;
  19
  20 BEGIN {
  21  require autovivification;
  22  if (autovivification::A_THREADSAFE()) {
  23   plan tests => 10 * 2 * 3 * (1 + 2);
  24   defined and diag "Using threads $_" for $threads::VERSION;
  25  } else {
  26   plan skip_all => 'This autovivification isn\'t thread safe';
  27  }
  28 }
  29
  30 {
  31  no autovivification;
  32
  33  sub try {
  34   my $tid = threads->tid();
  35
  36   for my $run (1 .. 2) {
  37    {
  38     my $x;
  39     my $y = $x->{foo};
  40     is $x, undef, "fetch does not autovivify at thread $tid run $run";
  41    }
  42    {
  43     my $x;
  44     my $y = exists $x->{foo};
  45     is $x, undef, "exists does not autovivify at thread $tid run $run";
  46    }
  47    {
  48     my $x;
  49     my $y = delete $x->{foo};
  50     is $x, undef, "delete does not autovivify at thread $tid run $run";
  51    }
  52
  53 SKIP:
  54    {
  55     skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2
  56                                                              unless $] >= 5.010;
  57     {
  58      my $x;
  59      eval 'my $y = $x->{foo}';
  60      is $@, '',    "fetch in eval does not croak at thread $tid run $run";
  61      is $x, undef, "fetch in eval does not autovivify at thread $tid run $run";
  62     }
  63     {
  64      my $x;
  65      eval 'my $y = exists $x->{foo}';
  66      is $@, '',    "exists in eval does not croak at thread $tid run $run";
  67      is $x, undef, "exists in eval does not autovivify at thread $tid run $run";
  68     }
  69     {
  70      my $x;
  71      eval 'my $y = delete $x->{foo}';
  72      is $@, '',    "delete in eval does not croak at thread $tid run $run";
  73      is $x, undef, "delete in eval does not autovivify at thread $tid run $run";
  74     }
  75    }
  76   }
  77  }
  78 }
  79
  80 my @t = map threads->create(\&try), 1 .. 10;
  81 $_->join for @t;