[p5sagit/Devel-PeekPoke.git] / t / 04thread-torture.t

use Config;
BEGIN {
  unless ($Config{useithreads}) {
    print "1..0 # SKIP your perl does not support ithreads\n";
    exit 0;
  }
}

use threads;
use threads::shared;

use strict;
use warnings;
no warnings 'once';
use Time::HiRes 'sleep';

$|++; # seems to be critical

share $::TEST_COUNT;

# older perls crash if threads are spawned way too quickly, sleep for 100 msecs
my @pool = map { sleep 0.1 and threads->create(\&run_torture) } (1..10);
$_->join for @pool;

if ($ENV{AUTOMATED_TESTING}) {
  my $vsz;
  if (-f "/proc/$$/stat") {
    my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
    ($vsz) = map { $_ / 1024 }
      (split (/\s+/, $proc_stat))[-22];  # go backwards because the %s of the procname can contain anything
  }

  printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
    if $vsz;
}

print "1..$::TEST_COUNT\n";

sub run_torture {
  my $src = do { local (@ARGV, $/) = 't/03torture.t'; <>; };
  eval $src;
  die $@ if $@ ne '';
}
Commit	Line	Data
24538b08	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	}