Commit | Line | Data |
3233f09d |
1 | use warnings; |
2 | use strict; |
3 | |
4 | use Time::HiRes 'time'; |
5 | |
6 | use Config; |
7 | # Manual skip, because Test::More can not load before threads.pm |
8 | BEGIN { |
9 | unless( $Config{useithreads} ) { |
10 | print( '1..0 # SKIP Your perl does not support ithreads' ); |
11 | exit 0; |
12 | } |
13 | } |
14 | |
15 | use threads; |
16 | use Test::More; |
17 | |
18 | eval { |
19 | require Exception::Guaranteed; |
20 | threads->VERSION(Exception::Guaranteed::THREADS_MIN_VERSION() ) |
21 | } or plan skip_all => "threads @{[ Exception::Guaranteed::THREADS_MIN_VERSION() ]} required for successfull testing"; |
22 | |
23 | my $rerun_test = 't/01basic.t'; |
24 | |
25 | my $worker = threads->create(sub { |
26 | $ENV{EXCEPTION_GUARANTEED_SUBTEST} = 1; |
27 | my $err = (do $rerun_test) || $@; |
28 | die "FAIL: $err" if $err; |
29 | return $ENV{EXCEPTION_GUARANTEED_SUBTEST}; |
30 | }); |
31 | |
32 | my $started_waitloop = time(); |
33 | my $sleep_per_loop = 2; |
34 | my $loops = 0; |
35 | do { |
36 | $loops++; |
37 | sleep $sleep_per_loop; |
38 | } while ( |
39 | !$worker->is_joinable |
40 | and |
41 | ( ($loops * $sleep_per_loop) < ($ENV{AUTOMATED_TESTING} ? 120 : 10 ) ) # some smokers are *really* slow |
42 | ); |
43 | my $waited_for = time - $started_waitloop; |
44 | |
45 | if ($worker->is_joinable) { |
46 | my $ret = $worker->join; |
47 | undef $worker; |
48 | is ($ret, 42, "$rerun_test in a thread completed successfully"); |
49 | } |
50 | else { |
51 | fail sprintf( 'Worker thread executing %s still not finished after %d seconds', |
52 | $rerun_test, |
53 | time - $started_waitloop, |
54 | ); |
55 | } |
56 | |
57 | cmp_ok ($waited_for, '>', 0, 'Main thread slept for some time'); |
58 | ok ( |
59 | # there should be less than a second of difference here |
60 | ($waited_for - ($loops * $sleep_per_loop) < 1), |
61 | "sleep in main thread appears undisturbed: $waited_for seconds after $loops loops of $sleep_per_loop secs" |
62 | ); |
63 | |
64 | |
65 | done_testing; |