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..10);
  23 $_->join for @pool;
  24
  25 if ($ENV{AUTOMATED_TESTING}) {
  26   my $vsz;
  27   if (-f "/proc/$$/stat") {
  28     my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
  29     ($vsz) = map { $_ / 1024 }
  30       (split (/\s+/, $proc_stat))[-22];  # go backwards because the %s of the procname can contain anything
  31   }
  32
  33   printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
  34     if $vsz;
  35 }
  36
  37 print "1..$::TEST_COUNT\n";
  38
  39 sub run_torture {
  40   my $src = do { local (@ARGV, $/) = 't/03torture.t'; <>; };
  41   eval $src;
  42   die $@ if $@ ne '';
  43 }