1#!/usr/bin/perl 2# 3# To the best of my knowledge, regular expressions aren't thread 4# safe in Perl. That's why the variable $Net::Daemon::RegExpLock 5# exists. If you want to check your Perl, try this script. 6# 7# On my Perl, 5.005_03 (i386-linux-thread) this produces a 8# Segfault almost reproducible. 9# 10# Please let me know if you are having better luck. 11# 12# Jochen Wiedmann, joe@ispsoft.de, 24-Jul-1999 13# 14# 15 16use Thread (); 17 18my $numChilds; 19my $regExpLock = @ARGV ? 1 : 0; 20 21# Repeat generating a random number and check if it contains the 22# substring '35'. 23sub Loop { 24 my $myNum = shift; 25 my $num1 = 0; 26 my $num2 = 0; 27 for (my $i = 1; $i <= 100000; $i++) { 28 if (($myNum == 1) and ($i % 10000) == 0) { 29 my $lck = lock $numChilds; 30 print $i, "\n"; 31 } 32 my $r = int(rand(100000)); 33 ++$num1 if index($r, '35') >= 0; 34 { 35 my $lck = lock $regExpLock if $regExpLock; 36 ++$num2 if $r =~ /(.*)35(.*)/; 37 } 38 } 39 return ($num1, $num2); 40} 41 42sub Run { 43 my $myNum = shift; 44 { 45 my $lck = lock $numChilds; 46 ++$numChilds; 47 print "Thread $myNum starting\n"; 48 } 49 my($num1, $num2) = eval { Loop($myNum) }; 50 my $err = $@; 51 $num1 ||= 0; 52 $num2 ||= 0; 53 { 54 my $lck = lock $numChilds; 55 --$numChilds; 56 print "Thread $myNum: Fatal error ($@)\n" if $err; 57 print "Thread $myNum, error: index = $num1, regexp = $num2\n" 58 if $num1 != $num2; 59 print "Thread $myNum leaving\n"; 60 } 61 return 1; 62} 63 64 65my @childs; 66for (my $i = 0; $i < 10; ++$i) { 67 print "Creating thread $i, TID = ", Thread->self->tid(), "\n"; 68 my $tid = Thread->new(\&Run, $i); 69 die "Failed to create thread: $!" unless $tid; 70 push(@childs, $tid); 71} 72 73foreach my $tid (@childs) { 74 $tid->join(); 75} 76