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 }
  31
  32 my ($threads, $runs);
  33 BEGIN {
  34  $threads = 10;
  35  $runs    = 2;
  36 }
  37
  38 BEGIN {
  39  plan tests => $threads * $runs * 3 * (1 + 2);
  40  defined and diag "Using threads $_" for $threads::VERSION;
  41 }
  42
  43 {
  44  no autovivification;
  45
  46  sub try {
  47   my $tid = threads->tid();
  48
  49   for my $run (1 .. $runs) {
  50    {
  51     my $x;
  52     my $y = $x->{foo};
  53     is $x, undef, "fetch does not autovivify at thread $tid run $run";
  54    }
  55    {
  56     my $x;
  57     my $y = exists $x->{foo};
  58     is $x, undef, "exists does not autovivify at thread $tid run $run";
  59    }
  60    {
  61     my $x;
  62     my $y = delete $x->{foo};
  63     is $x, undef, "delete does not autovivify at thread $tid run $run";
  64    }
  65
  66 SKIP:
  67    {
  68     skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2
  69                                                            unless "$]" >= 5.010;
  70     {
  71      my $x;
  72      eval 'my $y = $x->{foo}';
  73      is $@, '',    "fetch in eval does not croak at thread $tid run $run";
  74      is $x, undef, "fetch in eval does not autovivify at thread $tid run $run";
  75     }
  76     {
  77      my $x;
  78      eval 'my $y = exists $x->{foo}';
  79      is $@, '',    "exists in eval does not croak at thread $tid run $run";
  80      is $x, undef, "exists in eval does not autovivify at thread $tid run $run";
  81     }
  82     {
  83      my $x;
  84      eval 'my $y = delete $x->{foo}';
  85      is $@, '',    "delete in eval does not croak at thread $tid run $run";
  86      is $x, undef, "delete in eval does not autovivify at thread $tid run $run";
  87     }
  88    }
  89   }
  90  }
  91 }
  92
  93 my @t = map threads->create(\&try), 1 .. $threads;
  94 $_->join for @t;