Commit | Line | Data |
7483b81c |
1 | #!/usr/bin/perl -w |
2 | |
3 | # Test to see if we've worked around some wacky sort/threading bug |
4 | # See [rt.cpan.org 6782] |
5 | |
6 | BEGIN { |
7 | if( $ENV{PERL_CORE} ) { |
8 | chdir 't'; |
9 | @INC = ('../lib', 'lib'); |
10 | } |
11 | else { |
12 | unshift @INC, 't/lib'; |
13 | } |
14 | } |
15 | |
16 | use strict; |
17 | use Config; |
18 | |
19 | BEGIN { |
0257f296 |
20 | unless ( $] >= 5.008 && $Config{'useithreads'} && |
21 | eval { require threads; 'threads'->import; 1; }) |
22 | { |
23 | print "1..0 # Skip: no threads\n"; |
24 | exit 0; |
25 | } |
7483b81c |
26 | } |
27 | use Test::More; |
28 | |
29 | # Passes with $nthreads = 1 and with eq_set(). |
30 | # Passes with $nthreads = 2 and with eq_array(). |
31 | # Fails with $nthreads = 2 and with eq_set(). |
0257f296 |
32 | my $Num_Threads = 2; |
7483b81c |
33 | |
0257f296 |
34 | plan tests => $Num_Threads; |
7483b81c |
35 | |
36 | |
37 | sub do_one_thread { |
38 | my $kid = shift; |
39 | my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', |
40 | 'hello', 's', 'thisisalongname', '1', '2', '3', |
41 | 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); |
42 | my @list2 = @list; |
43 | print "# kid $kid before eq_set\n"; |
44 | |
45 | for my $j (1..99) { |
46 | # With eq_set, either crashes or panics |
47 | eq_set(\@list, \@list2); |
48 | eq_array(\@list, \@list2); |
49 | } |
50 | print "# kid $kid exit\n"; |
51 | return 42; |
52 | } |
53 | |
54 | my @kids = (); |
0257f296 |
55 | for my $i (1..$Num_Threads) { |
7483b81c |
56 | my $t = threads->new(\&do_one_thread, $i); |
57 | print "# parent $$: continue\n"; |
58 | push(@kids, $t); |
59 | } |
60 | for my $t (@kids) { |
61 | print "# parent $$: waiting for join\n"; |
62 | my $rc = $t->join(); |
63 | cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); |
64 | } |