ALT Linux Sisyphus - Пакет perl-Test-Fork

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 <schwern@pobox.com>',

    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 <schwern@pobox.com>'
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<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;
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 $?';

S:	0.02-alt1
5.1:	0.02-alt1