Test-Fork-0.02/000075500000000000000000000000001122676714600132635ustar00rootroot00000000000000Test-Fork-0.02/Build.PL000064400000000000000000000016021122676714600145560ustar00rootroot00000000000000#!/usr/bin/perl -w BEGIN { require 5.006001 } use Module::Build; my $build = Module::Build->new( module_name => 'Test::Fork', license => 'perl', dist_author => 'Michael G Schwern ', build_requires => { 'Test::More' => '0.62', 'Test::Builder::Tester' => '1.02', }, requires => { 'Test::Builder::Module' => '0.02', perl => '5.6.1', }, meta_merge => { configure_requires => { 'Module::Build' => '0.2808' }, resources => { license => 'http://dev.perl.org/licenses/', bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Fork', repository => 'http://svn.schwern.org/repos/CPAN/Test-Fork', } }, ); $build->create_build_script; Test-Fork-0.02/Changes000064400000000000000000000010261122676714600145550ustar00rootroot000000000000000.02 Wed Oct 15 00:45:46 EDT 2008 Features - fork_ok() now returns the PID of the forked process just like fork(). * Added some better diagnostics about what fork_ok() is doing. Bug Fixes * Fixed a race condition causing the reaper to wait for kids which have already been reaped. Tests - Add a test for the case when fork() fails. - Improve the test to ensure test numbers get turned back on after the children are all done. 0.01_01 Nov 30 20:02:00 PST 2007 First working releaseTest-Fork-0.02/MANIFEST000064400000000000000000000002111122676714600144060ustar00rootroot00000000000000Build.PL Changes lib/Test/Fork.pm MANIFEST META.yml t/failed_fork.t t/fork.t t/fork_ok_return.t SIGNATURE Added here by Module::Build Test-Fork-0.02/META.yml000064400000000000000000000012341122676714600145340ustar00rootroot00000000000000--- name: Test-Fork version: 0.02 author: - 'Michael G Schwern ' abstract: test code which forks license: perl resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Fork license: http://dev.perl.org/licenses/ repository: http://svn.schwern.org/repos/CPAN/Test-Fork requires: Test::Builder::Module: 0.02 perl: 5.6.1 build_requires: Test::Builder::Tester: 1.02 Test::More: 0.62 provides: Test::Fork: file: lib/Test/Fork.pm version: 0.02 generated_by: Module::Build version 0.3 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 configure_requires: Module::Build: 0.2808 Test-Fork-0.02/SIGNATURE000064400000000000000000000022501122676714600145460ustar00rootroot00000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 2cc539ab3e2d740694f20056a2d9b374f3decafe Build.PL SHA1 7d9cbad6b26af198d003e4b6393410c23988d689 Changes SHA1 c2227da32f8555d33a7890f6b7610842dac47832 MANIFEST SHA1 5713a9b99f67f99637b03df278fb6e58e7bafeb4 META.yml SHA1 bc7de84e525570f72d5d642e80ffc16ef3e3c849 lib/Test/Fork.pm SHA1 07942516a9c2c05ce673391679273038bd14da5a t/failed_fork.t SHA1 df16b4479b5f07126752c2fd8bdeee3ebbda05b9 t/fork.t SHA1 f8d72f86a18a318c779139b23d3a5139e46bab74 t/fork_ok_return.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (Darwin) iEYEARECAAYFAkj1drUACgkQWMohlhD1QydqhQCgpAi4a3IGPA7ztPVTf9Sg7uWp taAAoKy5s6G0XtqC6bsehRXKKg2cSfM5 =JiTC -----END PGP SIGNATURE----- Test-Fork-0.02/lib/000075500000000000000000000000001122676714600140315ustar00rootroot00000000000000Test-Fork-0.02/lib/Test/000075500000000000000000000000001122676714600147505ustar00rootroot00000000000000Test-Fork-0.02/lib/Test/Fork.pm000064400000000000000000000100161122676714600162050ustar00rootroot00000000000000package Test::Fork; use strict; use warnings; our $VERSION = '0.02'; use base 'Test::Builder::Module'; our @EXPORT = qw(fork_ok); my $CLASS = __PACKAGE__; sub note { my $msg = shift; my $fh = $CLASS->builder->output; print $fh "# $msg\n"; } =head1 NAME Test::Fork - test code which forks =head1 SYNOPSIS use Test::More tests => 4; use Test::Fork; fork_ok(2, sub{ pass("Test in the child process"); pass("Another test in the child process"); }); pass("Test in the parent"); =head1 DESCRIPTION B The implementation is unreliable and the interface is subject to change. Because each test has a number associated with it, testing code which forks is problematic. Coordinating the test number amongst the parent and child processes is complicated. Test::Fork provides a function to smooth over the complications. =head2 Functions Each function is exported by default. =head3 B my $child_pid = fork_ok( $num_tests, sub { ...child test code... }); Runs the given child test code in a forked process. Returns the pid of the forked child process, or false if the fork fails. $num_tests is the number of tests in your child test code. Consider it to be a sub-plan. fork_ok() itself is a test, if the fork fails it will fail. fork_ok() test does not count towards your $num_tests. # This is three tests. fork_ok( 2, sub { is $foo, $bar; ok Something->method; }); The children are automatically reaped. =cut my %Reaped; my %Running_Children; my $Is_Child = 0; sub fork_ok ($&) { my($num_tests, $child_sub) = @_; my $tb = $CLASS->builder; my $pid = fork; # Failed fork if( !defined $pid ) { return $tb->ok(0, "fork() failed: $!"); } # Parent elsif( $pid ) { # Avoid race condition where child has run and is reaped before # parent even runs. $Running_Children{$pid} = 1 unless $Reaped{$pid}; $tb->use_numbers(0); $tb->current_test($tb->current_test + $num_tests); $tb->ok(1, "fork() succeeded, child pid $pid"); return $pid; } # Child $Is_Child = 1; $tb->use_numbers(0); $tb->no_ending(1); note("Running child pid $$"); $child_sub->(); exit; } END { while( !$Is_Child and keys %Running_Children ) { note("reaper($$) waiting on @{[keys %Running_Children]}"); _check_kids(); _reaper(); } } sub _check_kids { for my $child (keys %Running_Children) { delete $Running_Children{$child} if $Reaped{$child}; delete $Running_Children{$child} unless kill 0, $child; note("Child $child already reaped"); } } sub _reaper { local $?; # wait sets $? my $child_pid = wait; $Reaped{$child_pid}++; delete $Running_Children{$child_pid}; note("child $child_pid reaped"); $CLASS->builder->use_numbers(1) unless keys %Running_Children; return $child_pid == -1 ? 0 : 1; } $SIG{CHLD} = \&_reaper; =head1 CAVEATS The failure of tests in a child process cannot be detected by the parent. Therefore, the normal end-of-test reporting done by Test::Builder will not notice failed child tests. Test::Fork turns off test numbering in order to avoid test counter coordination issues. It turns it back on once the children are done running. Test::Fork will wait for all your child processes to complete at the end of the parent process. =head1 SEE ALSO L =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 BUGS and FEEDBACK Please send all bugs and feature requests to I at I or use the web interface via L. If you use it, please send feedback. I like getting feedback. =head1 COPYRIGHT and LICENSE Copyright 2007-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 42; Test-Fork-0.02/t/000075500000000000000000000000001122676714600135265ustar00rootroot00000000000000Test-Fork-0.02/t/failed_fork.t000064400000000000000000000011611122676714600161570ustar00rootroot00000000000000#!/usr/bin/perl -w use Test::Builder::Tester tests => 2; use Test::More; # Doesn't actually matter what we set errno to, so long as we know # what the resulting string will be. my $errno = 1; my $errno_string; { local $! = $errno; $errno_string = $!; } # This must come before we use Test::Fork. BEGIN { *CORE::GLOBAL::fork = sub () { $! = $errno; return undef; }; } use Test::Fork; is fork(), undef, 'fork deliberately broken'; test_out("not ok 1 - fork() failed: $errno_string"); test_fail(+3); fork_ok(1, sub { fail(); }); test_test("fork_ok() fails when fork() doesn't work"); Test-Fork-0.02/t/fork.t000064400000000000000000000006101122676714600146510ustar00rootroot00000000000000#!/usr/bin/perl -w use Test::More tests => 10; my $Parent = $$; use_ok 'Test::Fork'; fork_ok(2, sub{ pass("child 1"); pass("child 1 again"); }); pass("parent one"); fork_ok(2, sub { pass("child 2"); pass("child 2 again"); }); pass("parent two"); 1 while Test::Fork::_reaper(); ok( Test::More->builder->use_numbers, "use_numbers back on after all children reaped" ); Test-Fork-0.02/t/fork_ok_return.t000064400000000000000000000005661122676714600167530ustar00rootroot00000000000000#!/usr/bin/perl -w use Test::More tests => 5; # This must come before we use Test::Fork. my $Forked_Pid; BEGIN { *CORE::GLOBAL::fork = sub () { return $Forked_Pid = CORE::fork; }; } use Test::Fork; is fork_ok(1, sub { pass }), $Forked_Pid, 'fork_ok() returns the child PID'; ok $Forked_Pid, '...just make sure we got a PID'; is $?, 0, 'No leak from $?';