File: race.t

package info (click to toggle)
libfile-counterfile-perl 1.04-2
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 56 kB
  • ctags: 10
  • sloc: perl: 224; makefile: 2
file content (58 lines) | stat: -rw-r--r-- 1,223 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#!/usr/bin/perl -w

BEGIN {
    # copied from t/op/fork.t from Perl 5.8.0:
    require Config; import Config;
    unless ($Config{'d_fork'}
	    or (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{useithreads}
		and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
               ))
    {
	print "1..0 # Skip: no fork\n";
	exit 0;
    }
}

use strict;
use File::CounterFile;
my $counter = "./zz-counter-$$";
unlink($counter);

$| = 1;

my $num_rounds = 100;
my $num_kids = 10;
my $num_incs = 10;

print "1..$num_rounds\n";

for my $round (1 .. $num_rounds) {
    for (1 .. $num_kids) {
	my $kid = fork();
	die "Can't fork: $!" unless defined $kid;
	next if $kid;
	
	#print "Child $$\n";
	#select(undef, undef, undef, 0.01);
	my $c = File::CounterFile->new($counter);
	for (1 .. $num_incs) {
	    #select(undef, undef, undef, 0.01);
	    my $v = $c->inc;
	    #print "$$: $v\n";
	}
	exit;
    }

    for (1 .. $num_kids) {
	my $pid = wait;
	die "Can't wait: $!" if $pid == -1;
	#print "Kid $pid done\n";
    }
    #print "All done\n";

    my $c = File::CounterFile->new($counter);
    print "not " unless $c->value == $num_kids * $num_incs;
    print "ok $round\n";

    unlink($counter) || warn "Can't unlink $counter: $!";
}