Perlito5

 view release on metacpan or  search on metacpan

lib/Perlito5X/Test2/API.pm  view on Meta::CPAN

# Private, for use in Test2::API::Context
sub _contexts_ref                  { $INST->contexts }
sub _context_acquire_callbacks_ref { $INST->context_acquire_callbacks }
sub _context_init_callbacks_ref    { $INST->context_init_callbacks }
sub _context_release_callbacks_ref { $INST->context_release_callbacks }

# Private, for use in Test2::IPC
sub _set_ipc { $INST->set_ipc(@_) }

sub context_do(&;@) {
    my $code = shift;
    my @args = @_;

    my $ctx = context(level => 1);

    my $want = wantarray;

    my @out;
    my $ok = eval {
        $want          ? @out    = $code->($ctx, @args) :

lib/Perlito5X/Test2/API.pm  view on Meta::CPAN

    $ctx->release;

    die $err unless $ok;

    return @out    if $want;
    return $out[0] if defined $want;
    return;
}

sub no_context(&;$) {
    my ($code, $hid) = @_;
    $hid ||= $STACK->top->hid;

    my $ctx = $CONTEXTS->{$hid};
    delete $CONTEXTS->{$hid};
    my $ok = eval { $code->(); 1 };
    my $err = $@;

    $CONTEXTS->{$hid} = $ctx;
    weaken($CONTEXTS->{$hid});

lib/Perlito5X/Test2/API.pm  view on Meta::CPAN

Removing the old context and creating a new one...
    EOT
}

sub release($;$) {
    $_[0]->release;
    return $_[1];
}

sub intercept(&) {
    my $code = shift;

    my $ctx = context();

    my $ipc;
    if (my $global_ipc = test2_ipc()) {
        my $driver = blessed($global_ipc);
        $ipc = $driver->new;
    }

lib/Perlito5X/Test2/Tools/Tiny.pm  view on Meta::CPAN

    $ctx->plan($max);
    $ctx->release;
}

sub done_testing {
    my $ctx = context();
    $ctx->done_testing;
    $ctx->release;
}

sub warnings(&) {
    my $code = shift;
    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();
    return \@warnings;
}

sub exception(&) {
    my $code = shift;
    local ($@, $!, $SIG{__DIE__});
    my $ok = eval { $code->(); 1 };
    my $error = $@ || 'SQUASHED ERROR';
    return $ok ? undef : $error;
}

sub tests {
    my ($name, $code) = @_;
    my $ctx = context();

    before_each() if __PACKAGE__->can('before_each');

    my $bool = run_subtest($name, $code, 1);

    $ctx->release;

    return $bool;
}

sub capture(&) {
    my $code = shift;

    my ($err, $out) = ("", "");

    my $handles = test2_stack->top->format->handles;
    my ($ok, $e);
    {
        my ($out_fh, $err_fh);

        ($ok, $e) = try {

lib/Perlito5X/Test2/Util.pm  view on Meta::CPAN

my $can_really_fork;
sub CAN_REALLY_FORK () {
    return $can_really_fork
        if defined $can_really_fork;
    $can_really_fork = !!$Config{d_fork};
    no warnings 'redefine';
    *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 };
    $can_really_fork;
}

sub _manual_try(&;@) {
    my $code = shift;
    my $args = \@_;
    my $err;

    my $die = delete $SIG{__DIE__};

    eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";

    $die ? $SIG{__DIE__} = $die : delete $SIG{__DIE__};

    return (!defined($err), $err);
}

sub _local_try(&;@) {
    my $code = shift;
    my $args = \@_;
    my $err;

    no warnings;
    local $SIG{__DIE__};
    eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";

    return (!defined($err), $err);
}