view release on metacpan or  search on metacpan

cpan/Test-Simple/t/Test2/modules/API/Context.t  view on Meta::CPAN

};

my $error = exception { context(); 1 };
my $exception = "context() called, but return value is ignored at " . __FILE__ . ' line ' . (__LINE__ - 1);
like($error, qr/^\Q$exception\E/, "Got the exception" );

my $ref;
my $frame;
sub wrap(&) {
    my $ctx = context();
    my ($pkg, $file, $line, $sub) = caller(0);
    $frame = [$pkg, $file, $line, $sub];

    $_[0]->($ctx);

    $ref = "$ctx";

    $ctx->release;
}

wrap {
    my $ctx = shift;
    ok($ctx->hub, "got hub");
    delete $ctx->trace->frame->[4];
    is_deeply($ctx->trace->frame, $frame, "Found place to report errors");
};

wrap {
    my $ctx = shift;
    ok("$ctx" ne "$ref", "Got a new context");
    my $new = context();
    my @caller = caller(0);
    is_deeply(
        $new,
        {%$ctx, _is_canon => undef, _is_spawn => [@caller[0,1,2,3]]},
        "Additional call to context gets spawn"
    );
    delete $ctx->trace->frame->[4];
    is_deeply($ctx->trace->frame, $frame, "Found place to report errors");
    $new->release;
};

wrap {
    my $ctx = shift;
    my $snap = $ctx->snapshot;

    is_deeply(
        $snap,
        {%$ctx, _is_canon => undef, _is_spawn => undef, _aborted => undef},
        "snapshot is identical except for canon/spawn/aborted"
    );
    ok($ctx != $snap, "snapshot is a new instance");
};

my $end_ctx;
{ # Simulate an END block...
    local *END = sub { local *__ANON__ = 'END'; context() };
    my $ctx = END();
    $frame = [ __PACKAGE__, __FILE__, __LINE__ - 1, 'main::END' ];
    # "__LINE__ - 1" on the preceding line forces the value to be an IV
    # (even though __LINE__ on its own is a PV), just as (caller)[2] is.
    $end_ctx = $ctx->snapshot;
    $ctx->release;
}
delete $end_ctx->trace->frame->[4];
is_deeply( $end_ctx->trace->frame, $frame, 'context is ok in an end block');

# Test event generation
{
    package My::Formatter;

    sub write {
        my $self = shift;
        my ($e) = @_;
        push @$self => $e;
    }
}
my $events = bless [], 'My::Formatter';
my $hub = Test2::Hub->new(
    formatter => $events,
);
my $trace = Test2::EventFacet::Trace->new(
    frame => [ 'Foo::Bar', 'foo_bar.t', 42, 'Foo::Bar::baz' ],
);
my $ctx = Test2::API::Context->new(
    trace => $trace,
    hub   => $hub,
);

my $e = $ctx->build_event('Ok', pass => 1, name => 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
ok(!@$events, "No events yet");

$e = $ctx->send_event('Ok', pass => 1, name => 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;

$e = $ctx->ok(1, 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;

$e = $ctx->note('foo');
is($e->message, 'foo', "got message");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;

$e = $ctx->diag('foo');
is($e->message, 'foo', "got message");
is_deeply($e->trace, $trace, "Got the trace info");