1use strict; 2use warnings; 3 4BEGIN { 5 use Config; 6 if (! $Config{'useithreads'}) { 7 print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); 8 exit(0); 9 } 10} 11 12use ExtUtils::testlib; 13 14use threads; 15 16BEGIN { 17 if (! eval 'use threads::shared; 1') { 18 print("1..0 # SKIP threads::shared not available\n"); 19 exit(0); 20 } 21 22 $| = 1; 23 print("1..5\n"); ### Number of tests that will be run ### 24}; 25 26my ($TEST, $COUNT, $TOTAL); 27 28BEGIN { 29 share($TEST); 30 $TEST = 1; 31 share($COUNT); 32 $COUNT = 0; 33 $TOTAL = 0; 34} 35 36ok(1, 'Loaded'); 37 38sub ok { 39 my ($ok, $name) = @_; 40 41 lock($TEST); 42 my $id = $TEST++; 43 44 # You have to do it this way or VMS will get confused. 45 if ($ok) { 46 print("ok $id - $name\n"); 47 } else { 48 print("not ok $id - $name\n"); 49 printf("# Failed test at line %d\n", (caller)[2]); 50 print(STDERR "# FAIL: $name\n") if (! $ENV{'PERL_CORE'}); 51 } 52 53 return ($ok); 54} 55 56 57### Start of Testing ### 58 59$SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); }; 60 61sub foo { lock($COUNT); $COUNT++; } 62sub baz { 42 } 63 64my $bthr; 65BEGIN { 66 $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); }; 67 68 $TOTAL++; 69 threads->create('foo')->join(); 70 $TOTAL++; 71 threads->create(\&foo)->join(); 72 $TOTAL++; 73 threads->create(sub { lock($COUNT); $COUNT++; })->join(); 74 75 $TOTAL++; 76 threads->create('foo')->detach(); 77 $TOTAL++; 78 threads->create(\&foo)->detach(); 79 $TOTAL++; 80 threads->create(sub { lock($COUNT); $COUNT++; })->detach(); 81 82 $bthr = threads->create('baz'); 83} 84 85my $mthr; 86MAIN: { 87 $TOTAL++; 88 threads->create('foo')->join(); 89 $TOTAL++; 90 threads->create(\&foo)->join(); 91 $TOTAL++; 92 threads->create(sub { lock($COUNT); $COUNT++; })->join(); 93 94 $TOTAL++; 95 threads->create('foo')->detach(); 96 $TOTAL++; 97 threads->create(\&foo)->detach(); 98 $TOTAL++; 99 threads->create(sub { lock($COUNT); $COUNT++; })->detach(); 100 101 $mthr = threads->create('baz'); 102} 103 104ok($mthr, 'Main thread'); 105ok($bthr, 'BEGIN thread'); 106 107ok($mthr->join() == 42, 'Main join'); 108ok($bthr->join() == 42, 'BEGIN join'); 109 110# Wait for detached threads to finish 111{ 112 threads->yield(); 113 sleep(1); 114 lock($COUNT); 115 redo if ($COUNT < $TOTAL); 116} 117 118exit(0); 119 120# EOF 121