t/04thread-torture.t

   1 use Config;
   2 BEGIN {
   3   unless ($Config{useithreads}) {
   4     print "1..0 # SKIP your perl does not support ithreads\n";
   5     exit 0;
   6   }
   7 }
   8
   9 use threads;
  10 use threads::shared;
  11
  12 use strict;
  13 use warnings;
  14 no warnings 'once';
  15 use Time::HiRes 'sleep';
  16
  17 $|++; # seems to be critical
  18
  19 share $::TEST_COUNT;
  20
  21 # older perls crash if threads are spawned way too quickly, sleep for 100 msecs
  22 my @pool = map { sleep 0.1 and threads->create(\&run_torture) } (1..($ENV{AUTOMATED_TESTING} ? 20 : 5) );
  23 for (@pool) {
  24   if ($_->join != 42) {
  25     die ($_->can('error') ? $_->error : "Thread did not finish successfully" );
  26   }
  27 }
  28
  29 if ($ENV{AUTOMATED_TESTING}) {
  30   my $vsz;
  31   if (-f "/proc/$$/stat") {
  32     my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
  33     ($vsz) = map { $_ / 1024 }
  34       (split (/\s+/, $proc_stat))[-22];  # go backwards because the %s of the procname can contain anything
  35   }
  36
  37   printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
  38     if $vsz;
  39 }
  40
  41 print "1..$::TEST_COUNT\n";
  42
  43 sub run_torture {
  44   do 't/03torture.t';
  45   die $@ if $@ ne '';
  46   42;
  47 }