t/50-threads.t

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