# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as erl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..10\n"; } END {print "not ok 1\n" unless $loaded;} use LaBrea::NetIO qw( reap_kids ); $loaded = 1; print "ok 1\n"; $test = 2; sub ok { print "ok $test\n"; ++$test; } sub next_sec { my ($then) = @_; $then = time unless $then; my $now; # wait for epoch do { select(undef,undef,undef,0.1); $now = time } while ( $then >= $now ); $now; } my $time = &next_sec; # sync to epoch my $n = 4; my %kids; foreach(1..$n) { my $pid = fork; unless ($pid) { # CHILD while (1) { exit unless &next_sec < ($time + $_); } } else { # PARENT $kids{$pid} = $_; } } my $alive = reap_kids(\%kids); print "have $alive kids, should have $n\nnot " unless $alive == $n; &ok; foreach my $job (1..$n) { while (($alive = reap_kids(\%kids)) > $n - $job) { select(undef,undef,undef,0.1); # delay } $now = time; print "$alive remaining kids, should have ", ($n - $job), "\nnot " unless $alive == $n - $job; &ok; print 'bad reaper timing ', $now - $time, " should be $job\nnot " unless $job == $now - $time; &ok; } while (1) { last unless reap_kids(\%kids); # purge remaining kids sleep 1; }