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