1#!/usr/bin/perl -w 2 3# Test to see if is_deeply() plays well with threads. 4 5BEGIN { 6 if( $ENV{PERL_CORE} ) { 7 chdir 't'; 8 @INC = ('../lib', 'lib'); 9 } 10 else { 11 unshift @INC, 't/lib'; 12 } 13} 14 15use strict; 16use Test2::Util qw/CAN_THREAD/; 17BEGIN { 18 unless(CAN_THREAD) { 19 require Test::More; 20 Test::More->import(skip_all => "threads are not supported"); 21 } 22} 23use threads; 24 25BEGIN { 26 unless ( $ENV{AUTHOR_TESTING} ) { 27 print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; 28 exit 0; 29 } 30} 31use Test::More; 32 33my $Num_Threads = 5; 34 35plan tests => $Num_Threads * 100 + 6; 36 37 38sub 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; 44 print "# kid $kid before is_deeply\n"; 45 46 for my $j (1..100) { 47 is_deeply(\@list, \@list2); 48 } 49 print "# kid $kid exit\n"; 50 return 42; 51} 52 53my @kids = (); 54for my $i (1..$Num_Threads) { 55 my $t = threads->new(\&do_one_thread, $i); 56 print "# parent $$: continue\n"; 57 push(@kids, $t); 58} 59for 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} 64 65pass("End of test"); 66