t/thread_it.pl

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 use Config;
   6 if (!$Config{useithreads}) {
   7     print "1..0 # Skip: no ithreads\n";
   8     exit 0;
   9 }
  10 if ($ENV{PERL_CORE_MINITEST}) {
  11     print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
  12     exit 0;
  13 }
  14
  15 require threads;
  16
  17 sub thread_it {
  18     # Generate things like './op/regexp.t', './t/op/regexp.t', ':op:regexp.t'
  19     my @paths
  20         = (join ('/', '.', @_), join ('/', '.', 't', @_), join (':', @_));
  21
  22     for my $file (@paths) {
  23         if (-r $file) {
  24             print "# found tests in $file\n";
  25             $::running_as_thread = "running tests in a new thread";
  26             do $file or die $@;
  27             print "# running tests in a new thread\n";
  28             my $curr = threads->create(sub {
  29                 run_tests();
  30                 return defined &curr_test ? curr_test() : ()
  31             })->join();
  32             curr_test($curr) if defined $curr;
  33             exit;
  34         }
  35     }
  36     die "Cannot find " . join (" or ", @paths) . "\n";
  37 }
  38
  39 1;