Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
Alien	[ DIR ]	drwxrwxrwx
Base	[ DIR ]	drwxrwxrwx
Deep	[ DIR ]	drwxrwxrwx
File	[ DIR ]	drwxrwxrwx
LeakTrace	[ DIR ]	drwxrwxrwx
NoWarnings	[ DIR ]	drwxrwxrwx
Number	[ DIR ]	drwxrwxrwx
Object	[ DIR ]	drwxrwxrwx
Without	[ DIR ]	drwxrwxrwx
Alien.pm	23.44 KB	-rw-rw-rw-
Base.pm	17.89 KB	-rw-rw-rw-
Base.pod	20.63 KB	-rw-rw-rw-
CleanNamespaces.pm	8.16 KB	-rw-rw-rw-
Deep.pm	48.95 KB	-rw-rw-rw-
Differences.pm	18.06 KB	-rw-rw-rw-
Exception.pm	15.1 KB	-rw-rw-rw-
FailWarnings.pm	5.32 KB	-rw-rw-rw-
Fatal.pm	11.04 KB	-rw-rw-rw-
File.pm	39.2 KB	-rw-rw-rw-
Fork.pm	4.01 KB	-rw-rw-rw-
LeakTrace.pm	7.09 KB	-rw-rw-rw-
MockTime.pm	6.49 KB	-rw-rw-rw-
Mojo.pm	33.89 KB	-rw-rw-rw-
Moose.pm	4.09 KB	-rw-rw-rw-
Needs.pm	8.05 KB	-rw-rw-rw-
NoWarnings.pm	7.44 KB	-rw-rw-rw-
Object.pm	4 KB	-rw-rw-rw-
Output.pm	21.9 KB	-rw-rw-rw-
Pod.pm	7.24 KB	-rw-rw-rw-
Requires.pm	3.6 KB	-rw-rw-rw-
RequiresInternet.pm	2.87 KB	-rw-rw-rw-
Script.pm	18.7 KB	-rw-rw-rw-
Specio.pm	40.38 KB	-rw-rw-rw-
SubCalls.pm	4.66 KB	-rw-rw-rw-
Warn.pm	15.52 KB	-rw-rw-rw-
Warnings.pm	14.29 KB	-rw-rw-rw-
YAML.pm	5.25 KB	-rw-rw-rw-
YAML.pod	710 B	-rw-rw-rw-
utf8.pm	10.44 KB	-rw-rw-rw-

Code Editor : Fork.pm

package 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<THIS IS ALPHA CODE!>  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<fork_ok>

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<Test::MultiFork>

=head1 AUTHOR

Michael G Schwern E<lt>schwern@pobox.comE<gt>

=head1 BUGS and FEEDBACK

Please send all bugs and feature requests to 
I<bug-Test-Fork> at I<rt.cpan.org> or use the web interface via
L<http://rt.cpan.org>.

If you use it, please send feedback.  I like getting feedback.

=head1 COPYRIGHT and LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F<http://www.perl.com/perl/misc/Artistic.html>

=cut

42;

${this.title}

Code Editor : Fork.pm