1*f3efcd01Safresh1#!perl 2*f3efcd01Safresh1use strict; 3*f3efcd01Safresh1use warnings; 4*f3efcd01Safresh1 5*f3efcd01Safresh1require './test.pl'; 6*f3efcd01Safresh1skip_all_without_config('useithreads'); 7*f3efcd01Safresh1skip_all_if_miniperl("no dynamic loading on miniperl, no threads"); 8*f3efcd01Safresh1 9*f3efcd01Safresh1plan(3); 10*f3efcd01Safresh1 11*f3efcd01Safresh1require threads; 12*f3efcd01Safresh1 13*f3efcd01Safresh1{ 14*f3efcd01Safresh1 fresh_perl_is(' 15*f3efcd01Safresh1 use threads; 16*f3efcd01Safresh1 use strict; 17*f3efcd01Safresh1 use warnings; 18*f3efcd01Safresh1 19*f3efcd01Safresh1 sub main::IsA { 20*f3efcd01Safresh1 use feature "state"; 21*f3efcd01Safresh1 22*f3efcd01Safresh1 state $upper_char = ord "A"; 23*f3efcd01Safresh1 state $lower_char = ord "a"; 24*f3efcd01Safresh1 25*f3efcd01Safresh1 return sprintf "%x", $lower_char++ if shift; 26*f3efcd01Safresh1 return sprintf "%x", $upper_char++; 27*f3efcd01Safresh1 } 28*f3efcd01Safresh1 29*f3efcd01Safresh1 my @threads = map +threads->create(sub { 30*f3efcd01Safresh1 sleep 0.1; 31*f3efcd01Safresh1 32*f3efcd01Safresh1 for (1..2500) { 33*f3efcd01Safresh1 return 0 unless eval "qq(A) =~ qr/\\\p{main::IsA}/"; 34*f3efcd01Safresh1 return 0 unless eval "qq(a) =~ qr/\\\p{main::IsA}/i"; 35*f3efcd01Safresh1 } 36*f3efcd01Safresh1 37*f3efcd01Safresh1 return 1; 38*f3efcd01Safresh1 }), (0..1); 39*f3efcd01Safresh1 my $success = $threads[0]->join; 40*f3efcd01Safresh1 $success += $threads[1]->join; 41*f3efcd01Safresh1 print $success;', 42*f3efcd01Safresh1 2, 43*f3efcd01Safresh1 {}, 44*f3efcd01Safresh1 "Simultaneous threads worked"); 45*f3efcd01Safresh1 46*f3efcd01Safresh1} 47*f3efcd01Safresh1 48*f3efcd01Safresh1{ 49*f3efcd01Safresh1 fresh_perl_is(' 50*f3efcd01Safresh1 use threads; 51*f3efcd01Safresh1 use strict; 52*f3efcd01Safresh1 use warnings; 53*f3efcd01Safresh1 54*f3efcd01Safresh1 sub InLongSleep { 55*f3efcd01Safresh1 use feature "state"; 56*f3efcd01Safresh1 57*f3efcd01Safresh1 state $which = 0; 58*f3efcd01Safresh1 59*f3efcd01Safresh1 sleep(60) unless $which++; 60*f3efcd01Safresh1 return "0042"; 61*f3efcd01Safresh1 } 62*f3efcd01Safresh1 63*f3efcd01Safresh1 sub InQuick { 64*f3efcd01Safresh1 return sprintf "%x", ord("C"); 65*f3efcd01Safresh1 } 66*f3efcd01Safresh1 67*f3efcd01Safresh1 my $thread0 = threads->create(sub { 68*f3efcd01Safresh1 69*f3efcd01Safresh1 my $a = \'\p{InLongSleep}\'; 70*f3efcd01Safresh1 qr/$a/; 71*f3efcd01Safresh1 72*f3efcd01Safresh1 return 1; 73*f3efcd01Safresh1 }); 74*f3efcd01Safresh1 my $thread1 = threads->create(sub { 75*f3efcd01Safresh1 sleep 1; 76*f3efcd01Safresh1 77*f3efcd01Safresh1 my $c = \'\p{InQuick}\'; 78*f3efcd01Safresh1 return "C" =~ /$c/; 79*f3efcd01Safresh1 }); 80*f3efcd01Safresh1 print $thread1->join; 81*f3efcd01Safresh1 $thread0->detach();', 82*f3efcd01Safresh1 1, 83*f3efcd01Safresh1 {}, 84*f3efcd01Safresh1 "One thread hung on a defn doesn't impinge on other's other defns"); 85*f3efcd01Safresh1} 86*f3efcd01Safresh1 87*f3efcd01Safresh1{ 88*f3efcd01Safresh1 fresh_perl_like(' 89*f3efcd01Safresh1 use threads; 90*f3efcd01Safresh1 use strict; 91*f3efcd01Safresh1 use warnings; 92*f3efcd01Safresh1 93*f3efcd01Safresh1 sub InLongSleep { 94*f3efcd01Safresh1 use feature "state"; 95*f3efcd01Safresh1 96*f3efcd01Safresh1 state $which = 0; 97*f3efcd01Safresh1 98*f3efcd01Safresh1 sleep(25) unless $which++; 99*f3efcd01Safresh1 return "0042"; 100*f3efcd01Safresh1 } 101*f3efcd01Safresh1 102*f3efcd01Safresh1 my @threads = map +threads->create(sub { 103*f3efcd01Safresh1 sleep 1; 104*f3efcd01Safresh1 105*f3efcd01Safresh1 my $a = \'\p{InLongSleep}\'; 106*f3efcd01Safresh1 qr/$a/; 107*f3efcd01Safresh1 108*f3efcd01Safresh1 return 1; 109*f3efcd01Safresh1 }), (0..1); 110*f3efcd01Safresh1 $threads[1]->join; 111*f3efcd01Safresh1 $threads[0]->detach();', 112*f3efcd01Safresh1 qr/Thread \d+ terminated abnormally: Timeout waiting for another thread to define "InLongSleep" in regex/, 113*f3efcd01Safresh1 {}, 114*f3efcd01Safresh1 "One thread hung on a definition doesn't delay another indefinitely"); 115*f3efcd01Safresh1} 116*f3efcd01Safresh1 117*f3efcd01Safresh11; 118