/usr/share/perl5/Test2/Tools/AsyncSubtest.pm is in libtest2-suite-perl 0.000102-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | package Test2::Tools::AsyncSubtest;
use strict;
use warnings;
our $VERSION = '0.000102';
use Test2::IPC;
use Test2::AsyncSubtest;
use Test2::API qw/context/;
use Carp qw/croak/;
our @EXPORT = qw/async_subtest fork_subtest thread_subtest/;
use base 'Exporter';
sub async_subtest {
my $name = shift;
my ($params, $code);
$params = shift(@_) if @_ && ref($_[0]) eq 'HASH';
$code = shift(@_) if @_ && ref($_[0]) eq 'CODE';
my $ctx = context();
my $subtest = Test2::AsyncSubtest->new(name => $name, context => 1, hub_init_args => $params);
$subtest->run($code, $subtest) if $code;
$ctx->release;
return $subtest;
}
sub fork_subtest {
my $name = shift;
my ($params, $code);
$params = shift(@_) if @_ && ref($_[0]) eq 'HASH';
$code = shift(@_) if @_ && ref($_[0]) eq 'CODE';
my $ctx = context();
croak "fork_subtest requires a CODE reference as the second argument"
unless ref($code) eq 'CODE';
my $subtest = Test2::AsyncSubtest->new(name => $name, context => 1, hub_init_args => $params);
$subtest->run_fork($code, $subtest);
$ctx->release;
return $subtest;
}
sub thread_subtest {
my $name = shift;
my ($params, $code);
$params = shift(@_) if @_ && ref($_[0]) eq 'HASH';
$code = shift(@_) if @_ && ref($_[0]) eq 'CODE';
my $ctx = context();
croak "thread_subtest requires a CODE reference as the second argument"
unless ref($code) eq 'CODE';
my $subtest = Test2::AsyncSubtest->new(name => $name, context => 1, hub_init_args => $params);
$subtest->run_thread($code, $subtest);
$ctx->release;
return $subtest;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test2::Tools::AsyncSubtest - Tools for writing async subtests.
=head1 DESCRIPTION
These are tools for writing async subtests. Async subtests are subtests which
can be started and stashed so that they can continue to receive events while
other events are also being generated.
=head1 SYNOPSIS
use Test2::Bundle::Extended;
use Test2::Tools::AsyncSubtest;
my $ast1 = async_subtest local => sub {
ok(1, "Inside subtest");
};
my $ast2 = fork_subtest child => sub {
ok(1, "Inside subtest in another process");
};
# You must call finish on the subtests you create. Finish will wait/join on
# any child processes and threads.
$ast1->finish;
$ast2->finish;
$ast3->finish;
done_testing;
=head1 EXPORTS
Everything is exported by default.
=over 4
=item $ast = async_subtest $name
=item $ast = async_subtest $name => sub { ... }
=item $ast = async_subtest $name => \%hub_params, sub { ... }
Create an async subtest. Run the codeblock if it is provided.
=item $ast = fork_subtest $name => sub { ... }
=item $ast = fork_subtest $name => \%hub_params, sub { ... }
Create an async subtest. Run the codeblock in a forked process.
=item $ast = thread_subtest $name => sub { ... }
=item $ast = thread_subtest $name => \%hub_params, sub { ... }
B<** DISCOURAGED **> Threads are fragile. Thread tests are not even run unless
the AUTHOR_TESTING or T2_DO_THREAD_TESTS env vars are enabled.
Create an async subtest. Run the codeblock in a thread.
=back
=head1 NOTES
=over 4
=item Async Subtests are always buffered.
=back
=head1 SOURCE
The source code repository for Test2-AsyncSubtest can be found at
F<https://github.com/Test-More/Test2-Suite/>.
=head1 MAINTAINERS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 AUTHORS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 COPYRIGHT
Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://dev.perl.org/licenses/>
=cut
|