view release on metacpan or  search on metacpan

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

    my ($ok, $err) = (1, undef);
    T2_SUBTEST_WRAPPER: {
        # Do not use 'try' cause it localizes __DIE__
        $ok = eval { $code->(hub => $hub, context => $ctx->snapshot); 1 };
        $err = $@;

        # They might have done 'BEGIN { skip_all => "whatever" }'
        if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && $err->isa('Test2::Hub::Interceptor::Terminator'))) {
            $ok  = 1;
            $err = undef;
        }
    }

    $hub->cull;
    $ctx->stack->pop($hub);

    my $trace = $ctx->trace;
    $ctx->release;

    die $err unless $ok;

    $hub->finalize($trace, 1)
        if $ok
        && !$hub->no_ending
        && !$hub->ended;

    return \@events;
}

sub run_subtest {
    my ($name, $code, $params, @args) = @_;

    $params = {buffered => $params} unless ref $params;
    my $buffered      = delete $params->{buffered};
    my $inherit_trace = delete $params->{inherit_trace};

    my $ctx = context();

    $ctx->note($name) unless $buffered;

    my $parent = $ctx->hub;

    my $stack = $ctx->stack || $STACK;
    my $hub = $stack->new_hub(
        class => 'Test2::Hub::Subtest',
        %$params,
    );

    my @events;
    $hub->set_nested( $parent->isa('Test2::Hub::Subtest') ? $parent->nested + 1 : 1 );
    $hub->listen(sub { push @events => $_[1] });

    if ($buffered) {
        if (my $format = $hub->format) {
            my $hide = $format->can('hide_buffered') ? $format->hide_buffered : 1;
            $hub->format(undef) if $hide;
        }
    }
    elsif (! $parent->format) {
        # If our parent has no format that means we're in a buffered subtest
        # and now we're trying to run a streaming subtest. There's really no
        # way for that to work, so we need to force the use of a buffered
        # subtest here as
        # well. https://github.com/Test-More/test-more/issues/721
        $buffered = 1;
    }

    if ($inherit_trace) {
        my $orig = $code;
        $code = sub {
            my $st_ctx = Test2::API::Context->new(
                trace => $ctx->trace,
                hub   => $hub,
            );
            $st_ctx->do_in_context($orig, @args);
        };
    }

    my ($ok, $err, $finished);
    T2_SUBTEST_WRAPPER: {
        # Do not use 'try' cause it localizes __DIE__
        $ok = eval { $code->(@args); 1 };
        $err = $@;

        # They might have done 'BEGIN { skip_all => "whatever" }'
        if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) {
            $ok  = undef;
            $err = undef;
        }
        else {
            $finished = 1;
        }
    }
    $stack->pop($hub);

    my $trace = $ctx->trace;

    if (!$finished) {
        if(my $bailed = $hub->bailed_out) {
            $ctx->bail($bailed->reason);
        }
        my $code = $hub->exit_code;
        $ok = !$code;
        $err = "Subtest ended with exit code $code" if $code;
    }

    $hub->finalize($trace, 1)
        if $ok
        && !$hub->no_ending
        && !$hub->ended;

    my $pass = $ok && $hub->is_passing;
    my $e = $ctx->build_event(
        'Subtest',
        pass       => $pass,
        name       => $name,
        subtest_id => $hub->id,
        buffered   => $buffered,
        subevents  => \@events,
    );