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..6\n"); ### Number of tests that will be run ### 24}; 25 26my $TEST; 27BEGIN { 28 share($TEST); 29 $TEST = 1; 30} 31 32ok(1, 'Loaded'); 33 34sub ok { 35 my ($ok, $name) = @_; 36 37 lock($TEST); 38 my $id = $TEST++; 39 40 # You have to do it this way or VMS will get confused. 41 if ($ok) { 42 print("ok $id - $name\n"); 43 } else { 44 print("not ok $id - $name\n"); 45 printf("# Failed test at line %d\n", (caller)[2]); 46 } 47 48 return ($ok); 49} 50 51 52### Start of Testing ### 53 54# Test that END blocks are run in the thread that created them, 55# and not in any child threads. 56 57END { 58 ok(1, 'Main END block') 59} 60 61threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join(); 62threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join(); 63 64sub thread { 65 eval "END { ok(1, '4th thread END block') }"; 66 threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join(); 67} 68threads->create(\&thread)->join(); 69 70exit(0); 71 72# EOF 73