t/02threads.t

   1 use warnings;
   2 use strict;
   3
   4 use Time::HiRes 'time';
   5
   6 use Config;
   7 # Manual skip, because Test::More can not load before threads.pm
   8 BEGIN {
   9   unless( $Config{useithreads} ) {
  10     print( '1..0 # SKIP Your perl does not support ithreads' );
  11     exit 0;
  12   }
  13 }
  14
  15 use threads;
  16 use Test::More;
  17
  18 eval {
  19   require Exception::Guaranteed;
  20   threads->VERSION(Exception::Guaranteed::THREADS_MIN_VERSION() )
  21 } or plan skip_all => "threads @{[ Exception::Guaranteed::THREADS_MIN_VERSION() ]} required for successfull testing";
  22
  23 my $rerun_test = 't/01basic.t';
  24
  25 my $worker = threads->create(sub {
  26   $ENV{EXCEPTION_GUARANTEED_SUBTEST} = 1;
  27   my $err = (do $rerun_test) || $@;
  28   die "FAIL: $err" if $err;
  29   return $ENV{EXCEPTION_GUARANTEED_SUBTEST};
  30 });
  31
  32 my $started_waitloop = time();
  33 my $sleep_per_loop = 2;
  34 my $loops = 0;
  35 do {
  36   $loops++;
  37   sleep $sleep_per_loop;
  38 } while (
  39   !$worker->is_joinable
  40     and
  41   ( ($loops * $sleep_per_loop) < ($ENV{AUTOMATED_TESTING} ? 120 : 10 ) )  # some smokers are *really* slow
  42 );
  43 my $waited_for = time - $started_waitloop;
  44
  45 if ($worker->is_joinable) {
  46   my $ret = $worker->join;
  47   undef $worker;
  48   is ($ret, 42, "$rerun_test in a thread completed successfully");
  49 }
  50 else {
  51   fail sprintf( 'Worker thread executing %s still not finished after %d seconds',
  52     $rerun_test,
  53     time - $started_waitloop,
  54   );
  55 }
  56
  57 cmp_ok ($waited_for, '>', 0, 'Main thread slept for some time');
  58 ok (
  59   # there should be less than a second of difference here
  60   ($waited_for - ($loops * $sleep_per_loop) < 1),
  61   "sleep in main thread appears undisturbed: $waited_for seconds after $loops loops of $sleep_per_loop secs"
  62 );
  63
  64
  65 done_testing;