Commit | Line | Data |
7483b81c |
1 | #!/usr/bin/perl -w |
2 | |
6b38a9b9 |
3 | # Test to see if is_deeply() plays well with threads. |
7483b81c |
4 | |
5 | BEGIN { |
6 | if( $ENV{PERL_CORE} ) { |
7 | chdir 't'; |
8 | @INC = ('../lib', 'lib'); |
9 | } |
10 | else { |
11 | unshift @INC, 't/lib'; |
12 | } |
13 | } |
14 | |
15 | use strict; |
16 | use Config; |
17 | |
18 | BEGIN { |
b7f9bbeb |
19 | unless ( $] >= 5.008001 && $Config{'useithreads'} && |
0257f296 |
20 | eval { require threads; 'threads'->import; 1; }) |
21 | { |
ccbd73a4 |
22 | print "1..0 # Skip no working threads\n"; |
0257f296 |
23 | exit 0; |
24 | } |
705e6672 |
25 | |
26 | unless ( $ENV{AUTHOR_TESTING} ) { |
ccbd73a4 |
27 | print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; |
705e6672 |
28 | exit 0; |
29 | } |
7483b81c |
30 | } |
31 | use Test::More; |
32 | |
6b38a9b9 |
33 | my $Num_Threads = 5; |
7483b81c |
34 | |
705e6672 |
35 | plan tests => $Num_Threads * 100 + 6; |
7483b81c |
36 | |
37 | |
38 | sub do_one_thread { |
39 | my $kid = shift; |
40 | my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', |
41 | 'hello', 's', 'thisisalongname', '1', '2', '3', |
42 | 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); |
43 | my @list2 = @list; |
4d845874 |
44 | print "# kid $kid before is_deeply\n"; |
7483b81c |
45 | |
6b38a9b9 |
46 | for my $j (1..100) { |
47 | is_deeply(\@list, \@list2); |
7483b81c |
48 | } |
49 | print "# kid $kid exit\n"; |
50 | return 42; |
51 | } |
52 | |
53 | my @kids = (); |
0257f296 |
54 | for my $i (1..$Num_Threads) { |
7483b81c |
55 | my $t = threads->new(\&do_one_thread, $i); |
56 | print "# parent $$: continue\n"; |
57 | push(@kids, $t); |
58 | } |
59 | for my $t (@kids) { |
60 | print "# parent $$: waiting for join\n"; |
61 | my $rc = $t->join(); |
62 | cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); |
63 | } |
705e6672 |
64 | |
65 | pass("End of test"); |