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'; |
13793f05 |
16 | use Cwd 'getcwd'; |
24538b08 |
17 | |
18 | $|++; # seems to be critical |
19 | |
20 | share $::TEST_COUNT; |
21 | |
22 | # older perls crash if threads are spawned way too quickly, sleep for 100 msecs |
e38f7884 |
23 | my @pool = map { sleep 0.1 and threads->create(\&run_torture) } (1..($ENV{AUTOMATED_TESTING} ? 20 : 5) ); |
c1ec81b5 |
24 | |
25 | # again - necessary for older perls |
26 | sleep 1; |
27 | |
e38f7884 |
28 | for (@pool) { |
29 | if ($_->join != 42) { |
30 | die ($_->can('error') ? $_->error : "Thread did not finish successfully" ); |
31 | } |
32 | } |
24538b08 |
33 | |
34 | if ($ENV{AUTOMATED_TESTING}) { |
35 | my $vsz; |
36 | if (-f "/proc/$$/stat") { |
37 | my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> }; |
38 | ($vsz) = map { $_ / 1024 } |
39 | (split (/\s+/, $proc_stat))[-22]; # go backwards because the %s of the procname can contain anything |
40 | } |
41 | |
42 | printf STDERR "#\n# VSIZE:%dKiB\n", $vsz |
43 | if $vsz; |
44 | } |
45 | |
46 | print "1..$::TEST_COUNT\n"; |
47 | |
48 | sub run_torture { |
13793f05 |
49 | do( ( "@{[ getcwd() ]}/t/03torture.t" =~ /^(.*)$/ )[0] ); |
24538b08 |
50 | die $@ if $@ ne ''; |
e38f7884 |
51 | 42; |
24538b08 |
52 | } |