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