xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/lib/Test2/API/Context.pm (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
15759b3d2Safresh1package Test2::API::Context;
25759b3d2Safresh1use strict;
35759b3d2Safresh1use warnings;
45759b3d2Safresh1
5*5486feefSafresh1our $VERSION = '1.302199';
65759b3d2Safresh1
75759b3d2Safresh1
85759b3d2Safresh1use Carp qw/confess croak/;
95759b3d2Safresh1use Scalar::Util qw/weaken blessed/;
105759b3d2Safresh1use Test2::Util qw/get_tid try pkg_to_file get_tid/;
115759b3d2Safresh1
125759b3d2Safresh1use Test2::EventFacet::Trace();
135759b3d2Safresh1use Test2::API();
145759b3d2Safresh1
155759b3d2Safresh1# Preload some key event types
165759b3d2Safresh1my %LOADED = (
175759b3d2Safresh1    map {
185759b3d2Safresh1        my $pkg  = "Test2::Event::$_";
195759b3d2Safresh1        my $file = "Test2/Event/$_.pm";
205759b3d2Safresh1        require $file unless $INC{$file};
215759b3d2Safresh1        ( $pkg => $pkg, $_ => $pkg )
225759b3d2Safresh1    } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail V2/
235759b3d2Safresh1);
245759b3d2Safresh1
255759b3d2Safresh1use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
265759b3d2Safresh1use Test2::Util::HashBase qw{
275759b3d2Safresh1    stack hub trace _on_release _depth _is_canon _is_spawn _aborted
285759b3d2Safresh1    errno eval_error child_error thrown
295759b3d2Safresh1};
305759b3d2Safresh1
315759b3d2Safresh1# Private, not package vars
325759b3d2Safresh1# It is safe to cache these.
335759b3d2Safresh1my $ON_RELEASE = Test2::API::_context_release_callbacks_ref();
345759b3d2Safresh1my $CONTEXTS   = Test2::API::_contexts_ref();
355759b3d2Safresh1
365759b3d2Safresh1sub init {
375759b3d2Safresh1    my $self = shift;
385759b3d2Safresh1
395759b3d2Safresh1    confess "The 'trace' attribute is required"
405759b3d2Safresh1        unless $self->{+TRACE};
415759b3d2Safresh1
425759b3d2Safresh1    confess "The 'hub' attribute is required"
435759b3d2Safresh1        unless $self->{+HUB};
445759b3d2Safresh1
455759b3d2Safresh1    $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH};
465759b3d2Safresh1
475759b3d2Safresh1    $self->{+ERRNO}       = $! unless exists $self->{+ERRNO};
485759b3d2Safresh1    $self->{+EVAL_ERROR}  = $@ unless exists $self->{+EVAL_ERROR};
495759b3d2Safresh1    $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR};
505759b3d2Safresh1}
515759b3d2Safresh1
525759b3d2Safresh1sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ }
535759b3d2Safresh1
545759b3d2Safresh1sub restore_error_vars {
555759b3d2Safresh1    my $self = shift;
565759b3d2Safresh1    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
575759b3d2Safresh1}
585759b3d2Safresh1
595759b3d2Safresh1sub DESTROY {
605759b3d2Safresh1    return unless $_[0]->{+_IS_CANON} || $_[0]->{+_IS_SPAWN};
615759b3d2Safresh1    return if $_[0]->{+_ABORTED} && ${$_[0]->{+_ABORTED}};
625759b3d2Safresh1    my ($self) = @_;
635759b3d2Safresh1
645759b3d2Safresh1    my $hub = $self->{+HUB};
655759b3d2Safresh1    my $hid = $hub->{hid};
665759b3d2Safresh1
675759b3d2Safresh1    # Do not show the warning if it looks like an exception has been thrown, or
685759b3d2Safresh1    # if the context is not local to this process or thread.
695759b3d2Safresh1    {
705759b3d2Safresh1        # Sometimes $@ is uninitialized, not a problem in this case so do not
715759b3d2Safresh1        # show the warning about using eq.
725759b3d2Safresh1        no warnings 'uninitialized';
735759b3d2Safresh1        if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) {
74de8cc8edSafresh1            require Carp;
75de8cc8edSafresh1            my $mess = Carp::longmess("Context destroyed");
765759b3d2Safresh1            my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame;
775759b3d2Safresh1            warn <<"            EOT";
785759b3d2Safresh1A context appears to have been destroyed without first calling release().
795759b3d2Safresh1Based on \$@ it does not look like an exception was thrown (this is not always
805759b3d2Safresh1a reliable test)
815759b3d2Safresh1
825759b3d2Safresh1This is a problem because the global error variables (\$!, \$@, and \$?) will
835759b3d2Safresh1not be restored. In addition some release callbacks will not work properly from
845759b3d2Safresh1inside a DESTROY method.
855759b3d2Safresh1
865759b3d2Safresh1Here are the context creation details, just in case a tool forgot to call
875759b3d2Safresh1release():
885759b3d2Safresh1  File: $frame->[1]
895759b3d2Safresh1  Line: $frame->[2]
905759b3d2Safresh1  Tool: $frame->[3]
915759b3d2Safresh1
92de8cc8edSafresh1Here is a trace to the code that caused the context to be destroyed, this could
93de8cc8edSafresh1be an exit(), a goto, or simply the end of a scope:
94de8cc8edSafresh1$mess
95de8cc8edSafresh1
965759b3d2Safresh1Cleaning up the CONTEXT stack...
975759b3d2Safresh1            EOT
985759b3d2Safresh1        }
995759b3d2Safresh1    }
1005759b3d2Safresh1
1015759b3d2Safresh1    return if $self->{+_IS_SPAWN};
1025759b3d2Safresh1
1035759b3d2Safresh1    # Remove the key itself to avoid a slow memory leak
1045759b3d2Safresh1    delete $CONTEXTS->{$hid};
1055759b3d2Safresh1    $self->{+_IS_CANON} = undef;
1065759b3d2Safresh1
1075759b3d2Safresh1    if (my $cbk = $self->{+_ON_RELEASE}) {
1085759b3d2Safresh1        $_->($self) for reverse @$cbk;
1095759b3d2Safresh1    }
1105759b3d2Safresh1    if (my $hcbk = $hub->{_context_release}) {
1115759b3d2Safresh1        $_->($self) for reverse @$hcbk;
1125759b3d2Safresh1    }
1135759b3d2Safresh1    $_->($self) for reverse @$ON_RELEASE;
1145759b3d2Safresh1}
1155759b3d2Safresh1
1165759b3d2Safresh1# release exists to implement behaviors like die-on-fail. In die-on-fail you
1175759b3d2Safresh1# want to die after a failure, but only after diagnostics have been reported.
1185759b3d2Safresh1# The ideal time for the die to happen is when the context is released.
1195759b3d2Safresh1# Unfortunately die does not work in a DESTROY block.
1205759b3d2Safresh1sub release {
1215759b3d2Safresh1    my ($self) = @_;
1225759b3d2Safresh1
1235759b3d2Safresh1    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return if $self->{+THROWN};
1245759b3d2Safresh1
1255759b3d2Safresh1    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return $self->{+_IS_SPAWN} = undef
1265759b3d2Safresh1        if $self->{+_IS_SPAWN};
1275759b3d2Safresh1
1285759b3d2Safresh1    croak "release() should not be called on context that is neither canon nor a child"
1295759b3d2Safresh1        unless $self->{+_IS_CANON};
1305759b3d2Safresh1
1315759b3d2Safresh1    my $hub = $self->{+HUB};
1325759b3d2Safresh1    my $hid = $hub->{hid};
1335759b3d2Safresh1
1345759b3d2Safresh1    croak "context thinks it is canon, but it is not"
1355759b3d2Safresh1        unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self;
1365759b3d2Safresh1
1375759b3d2Safresh1    # Remove the key itself to avoid a slow memory leak
1385759b3d2Safresh1    $self->{+_IS_CANON} = undef;
1395759b3d2Safresh1    delete $CONTEXTS->{$hid};
1405759b3d2Safresh1
1415759b3d2Safresh1    if (my $cbk = $self->{+_ON_RELEASE}) {
1425759b3d2Safresh1        $_->($self) for reverse @$cbk;
1435759b3d2Safresh1    }
1445759b3d2Safresh1    if (my $hcbk = $hub->{_context_release}) {
1455759b3d2Safresh1        $_->($self) for reverse @$hcbk;
1465759b3d2Safresh1    }
1475759b3d2Safresh1    $_->($self) for reverse @$ON_RELEASE;
1485759b3d2Safresh1
1495759b3d2Safresh1    # Do this last so that nothing else changes them.
1505759b3d2Safresh1    # If one of the hooks dies then these do not get restored, this is
1515759b3d2Safresh1    # intentional
1525759b3d2Safresh1    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
1535759b3d2Safresh1
1545759b3d2Safresh1    return;
1555759b3d2Safresh1}
1565759b3d2Safresh1
1575759b3d2Safresh1sub do_in_context {
1585759b3d2Safresh1    my $self = shift;
1595759b3d2Safresh1    my ($sub, @args) = @_;
1605759b3d2Safresh1
1615759b3d2Safresh1    # We need to update the pid/tid and error vars.
1625759b3d2Safresh1    my $clone = $self->snapshot;
1635759b3d2Safresh1    @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?);
1645759b3d2Safresh1    $clone->{+TRACE} = $clone->{+TRACE}->snapshot(pid => $$, tid => get_tid());
1655759b3d2Safresh1
1665759b3d2Safresh1    my $hub = $clone->{+HUB};
1675759b3d2Safresh1    my $hid = $hub->hid;
1685759b3d2Safresh1
1695759b3d2Safresh1    my $old = $CONTEXTS->{$hid};
1705759b3d2Safresh1
1715759b3d2Safresh1    $clone->{+_IS_CANON} = 1;
1725759b3d2Safresh1    $CONTEXTS->{$hid} = $clone;
1735759b3d2Safresh1    weaken($CONTEXTS->{$hid});
1745759b3d2Safresh1    my ($ok, $err) = &try($sub, @args);
1755759b3d2Safresh1    my ($rok, $rerr) = try { $clone->release };
1765759b3d2Safresh1    delete $clone->{+_IS_CANON};
1775759b3d2Safresh1
1785759b3d2Safresh1    if ($old) {
1795759b3d2Safresh1        $CONTEXTS->{$hid} = $old;
1805759b3d2Safresh1        weaken($CONTEXTS->{$hid});
1815759b3d2Safresh1    }
1825759b3d2Safresh1    else {
1835759b3d2Safresh1        delete $CONTEXTS->{$hid};
1845759b3d2Safresh1    }
1855759b3d2Safresh1
1865759b3d2Safresh1    die $err  unless $ok;
1875759b3d2Safresh1    die $rerr unless $rok;
1885759b3d2Safresh1}
1895759b3d2Safresh1
1905759b3d2Safresh1sub done_testing {
1915759b3d2Safresh1    my $self = shift;
1925759b3d2Safresh1    $self->hub->finalize($self->trace, 1);
1935759b3d2Safresh1    return;
1945759b3d2Safresh1}
1955759b3d2Safresh1
1965759b3d2Safresh1sub throw {
1975759b3d2Safresh1    my ($self, $msg) = @_;
1985759b3d2Safresh1    $self->{+THROWN} = 1;
1995759b3d2Safresh1    ${$self->{+_ABORTED}}++ if $self->{+_ABORTED};
2005759b3d2Safresh1    $self->release if $self->{+_IS_CANON} || $self->{+_IS_SPAWN};
2015759b3d2Safresh1    $self->trace->throw($msg);
2025759b3d2Safresh1}
2035759b3d2Safresh1
2045759b3d2Safresh1sub alert {
2055759b3d2Safresh1    my ($self, $msg) = @_;
2065759b3d2Safresh1    $self->trace->alert($msg);
2075759b3d2Safresh1}
2085759b3d2Safresh1
2095759b3d2Safresh1sub send_ev2_and_release {
2105759b3d2Safresh1    my $self = shift;
2115759b3d2Safresh1    my $out  = $self->send_ev2(@_);
2125759b3d2Safresh1    $self->release;
2135759b3d2Safresh1    return $out;
2145759b3d2Safresh1}
2155759b3d2Safresh1
2165759b3d2Safresh1sub send_ev2 {
2175759b3d2Safresh1    my $self = shift;
2185759b3d2Safresh1
2195759b3d2Safresh1    my $e;
2205759b3d2Safresh1    {
2215759b3d2Safresh1        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
2225759b3d2Safresh1        $e = Test2::Event::V2->new(
2235759b3d2Safresh1            trace => $self->{+TRACE}->snapshot,
2245759b3d2Safresh1            @_,
2255759b3d2Safresh1        );
2265759b3d2Safresh1    }
2275759b3d2Safresh1
2285759b3d2Safresh1    if ($self->{+_ABORTED}) {
2295759b3d2Safresh1        my $f = $e->facet_data;
2305759b3d2Safresh1        ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
2315759b3d2Safresh1    }
2325759b3d2Safresh1    $self->{+HUB}->send($e);
2335759b3d2Safresh1}
2345759b3d2Safresh1
2355759b3d2Safresh1sub build_ev2 {
2365759b3d2Safresh1    my $self = shift;
2375759b3d2Safresh1
2385759b3d2Safresh1    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
2395759b3d2Safresh1    Test2::Event::V2->new(
2405759b3d2Safresh1        trace => $self->{+TRACE}->snapshot,
2415759b3d2Safresh1        @_,
2425759b3d2Safresh1    );
2435759b3d2Safresh1}
2445759b3d2Safresh1
2455759b3d2Safresh1sub send_event_and_release {
2465759b3d2Safresh1    my $self = shift;
2475759b3d2Safresh1    my $out = $self->send_event(@_);
2485759b3d2Safresh1    $self->release;
2495759b3d2Safresh1    return $out;
2505759b3d2Safresh1}
2515759b3d2Safresh1
2525759b3d2Safresh1sub send_event {
2535759b3d2Safresh1    my $self  = shift;
2545759b3d2Safresh1    my $event = shift;
2555759b3d2Safresh1    my %args  = @_;
2565759b3d2Safresh1
2575759b3d2Safresh1    my $pkg = $LOADED{$event} || $self->_parse_event($event);
2585759b3d2Safresh1
2595759b3d2Safresh1    my $e;
2605759b3d2Safresh1    {
2615759b3d2Safresh1        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
2625759b3d2Safresh1        $e = $pkg->new(
2635759b3d2Safresh1            trace => $self->{+TRACE}->snapshot,
2645759b3d2Safresh1            %args,
2655759b3d2Safresh1        );
2665759b3d2Safresh1    }
2675759b3d2Safresh1
2685759b3d2Safresh1    if ($self->{+_ABORTED}) {
2695759b3d2Safresh1        my $f = $e->facet_data;
2705759b3d2Safresh1        ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
2715759b3d2Safresh1    }
2725759b3d2Safresh1    $self->{+HUB}->send($e);
2735759b3d2Safresh1}
2745759b3d2Safresh1
2755759b3d2Safresh1sub build_event {
2765759b3d2Safresh1    my $self  = shift;
2775759b3d2Safresh1    my $event = shift;
2785759b3d2Safresh1    my %args  = @_;
2795759b3d2Safresh1
2805759b3d2Safresh1    my $pkg = $LOADED{$event} || $self->_parse_event($event);
2815759b3d2Safresh1
2825759b3d2Safresh1    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
2835759b3d2Safresh1    $pkg->new(
2845759b3d2Safresh1        trace => $self->{+TRACE}->snapshot,
2855759b3d2Safresh1        %args,
2865759b3d2Safresh1    );
2875759b3d2Safresh1}
2885759b3d2Safresh1
2895759b3d2Safresh1sub pass {
2905759b3d2Safresh1    my $self = shift;
2915759b3d2Safresh1    my ($name) = @_;
2925759b3d2Safresh1
2935759b3d2Safresh1    my $e = bless(
2945759b3d2Safresh1        {
2955759b3d2Safresh1            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
2965759b3d2Safresh1            name  => $name,
2975759b3d2Safresh1        },
2985759b3d2Safresh1        "Test2::Event::Pass"
2995759b3d2Safresh1    );
3005759b3d2Safresh1
3015759b3d2Safresh1    $self->{+HUB}->send($e);
3025759b3d2Safresh1    return $e;
3035759b3d2Safresh1}
3045759b3d2Safresh1
3055759b3d2Safresh1sub pass_and_release {
3065759b3d2Safresh1    my $self = shift;
3075759b3d2Safresh1    my ($name) = @_;
3085759b3d2Safresh1
3095759b3d2Safresh1    my $e = bless(
3105759b3d2Safresh1        {
3115759b3d2Safresh1            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
3125759b3d2Safresh1            name  => $name,
3135759b3d2Safresh1        },
3145759b3d2Safresh1        "Test2::Event::Pass"
3155759b3d2Safresh1    );
3165759b3d2Safresh1
3175759b3d2Safresh1    $self->{+HUB}->send($e);
3185759b3d2Safresh1    $self->release;
3195759b3d2Safresh1    return 1;
3205759b3d2Safresh1}
3215759b3d2Safresh1
3225759b3d2Safresh1sub fail {
3235759b3d2Safresh1    my $self = shift;
3245759b3d2Safresh1    my ($name, @diag) = @_;
3255759b3d2Safresh1
3265759b3d2Safresh1    my $e = bless(
3275759b3d2Safresh1        {
3285759b3d2Safresh1            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
3295759b3d2Safresh1            name  => $name,
3305759b3d2Safresh1        },
3315759b3d2Safresh1        "Test2::Event::Fail"
3325759b3d2Safresh1    );
3335759b3d2Safresh1
334f3efcd01Safresh1    for my $msg (@diag) {
335f3efcd01Safresh1        if (ref($msg) eq 'Test2::EventFacet::Info::Table') {
336f3efcd01Safresh1            $e->add_info({tag => 'DIAG', debug => 1, $msg->info_args});
337f3efcd01Safresh1        }
338f3efcd01Safresh1        else {
339f3efcd01Safresh1            $e->add_info({tag => 'DIAG', debug => 1, details => $msg});
340f3efcd01Safresh1        }
341f3efcd01Safresh1    }
342f3efcd01Safresh1
3435759b3d2Safresh1    $self->{+HUB}->send($e);
3445759b3d2Safresh1    return $e;
3455759b3d2Safresh1}
3465759b3d2Safresh1
3475759b3d2Safresh1sub fail_and_release {
3485759b3d2Safresh1    my $self = shift;
3495759b3d2Safresh1    my ($name, @diag) = @_;
3505759b3d2Safresh1
3515759b3d2Safresh1    my $e = bless(
3525759b3d2Safresh1        {
3535759b3d2Safresh1            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
3545759b3d2Safresh1            name  => $name,
3555759b3d2Safresh1        },
3565759b3d2Safresh1        "Test2::Event::Fail"
3575759b3d2Safresh1    );
3585759b3d2Safresh1
359f3efcd01Safresh1    for my $msg (@diag) {
360f3efcd01Safresh1        if (ref($msg) eq 'Test2::EventFacet::Info::Table') {
361f3efcd01Safresh1            $e->add_info({tag => 'DIAG', debug => 1, $msg->info_args});
362f3efcd01Safresh1        }
363f3efcd01Safresh1        else {
364f3efcd01Safresh1            $e->add_info({tag => 'DIAG', debug => 1, details => $msg});
365f3efcd01Safresh1        }
366f3efcd01Safresh1    }
367f3efcd01Safresh1
3685759b3d2Safresh1    $self->{+HUB}->send($e);
3695759b3d2Safresh1    $self->release;
3705759b3d2Safresh1    return 0;
3715759b3d2Safresh1}
3725759b3d2Safresh1
3735759b3d2Safresh1sub ok {
3745759b3d2Safresh1    my $self = shift;
3755759b3d2Safresh1    my ($pass, $name, $on_fail) = @_;
3765759b3d2Safresh1
3775759b3d2Safresh1    my $hub = $self->{+HUB};
3785759b3d2Safresh1
3795759b3d2Safresh1    my $e = bless {
3805759b3d2Safresh1        trace => bless( {%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
3815759b3d2Safresh1        pass  => $pass,
3825759b3d2Safresh1        name  => $name,
3835759b3d2Safresh1    }, 'Test2::Event::Ok';
3845759b3d2Safresh1    $e->init;
3855759b3d2Safresh1
3865759b3d2Safresh1    $hub->send($e);
3875759b3d2Safresh1    return $e if $pass;
3885759b3d2Safresh1
3895759b3d2Safresh1    $self->failure_diag($e);
3905759b3d2Safresh1
3915759b3d2Safresh1    if ($on_fail && @$on_fail) {
3925759b3d2Safresh1        $self->diag($_) for @$on_fail;
3935759b3d2Safresh1    }
3945759b3d2Safresh1
3955759b3d2Safresh1    return $e;
3965759b3d2Safresh1}
3975759b3d2Safresh1
3985759b3d2Safresh1sub failure_diag {
3995759b3d2Safresh1    my $self = shift;
4005759b3d2Safresh1    my ($e) = @_;
4015759b3d2Safresh1
4025759b3d2Safresh1    # Figure out the debug info, this is typically the file name and line
4035759b3d2Safresh1    # number, but can also be a custom message. If no trace object is provided
4045759b3d2Safresh1    # then we have nothing useful to display.
4055759b3d2Safresh1    my $name  = $e->name;
4065759b3d2Safresh1    my $trace = $e->trace;
4075759b3d2Safresh1    my $debug = $trace ? $trace->debug : "[No trace info available]";
4085759b3d2Safresh1
4095759b3d2Safresh1    # Create the initial diagnostics. If the test has a name we put the debug
4105759b3d2Safresh1    # info on a second line, this behavior is inherited from Test::Builder.
4115759b3d2Safresh1    my $msg = defined($name)
4125759b3d2Safresh1        ? qq[Failed test '$name'\n$debug.\n]
4135759b3d2Safresh1        : qq[Failed test $debug.\n];
4145759b3d2Safresh1
4155759b3d2Safresh1    $self->diag($msg);
4165759b3d2Safresh1}
4175759b3d2Safresh1
4185759b3d2Safresh1sub skip {
4195759b3d2Safresh1    my $self = shift;
4205759b3d2Safresh1    my ($name, $reason, @extra) = @_;
4215759b3d2Safresh1    $self->send_event(
4225759b3d2Safresh1        'Skip',
4235759b3d2Safresh1        name => $name,
4245759b3d2Safresh1        reason => $reason,
4255759b3d2Safresh1        pass => 1,
4265759b3d2Safresh1        @extra,
4275759b3d2Safresh1    );
4285759b3d2Safresh1}
4295759b3d2Safresh1
4305759b3d2Safresh1sub note {
4315759b3d2Safresh1    my $self = shift;
4325759b3d2Safresh1    my ($message) = @_;
4335759b3d2Safresh1    $self->send_event('Note', message => $message);
4345759b3d2Safresh1}
4355759b3d2Safresh1
4365759b3d2Safresh1sub diag {
4375759b3d2Safresh1    my $self = shift;
4385759b3d2Safresh1    my ($message) = @_;
4395759b3d2Safresh1    $self->send_event(
4405759b3d2Safresh1        'Diag',
4415759b3d2Safresh1        message => $message,
4425759b3d2Safresh1    );
4435759b3d2Safresh1}
4445759b3d2Safresh1
4455759b3d2Safresh1sub plan {
4465759b3d2Safresh1    my ($self, $max, $directive, $reason) = @_;
4475759b3d2Safresh1    $self->send_event('Plan', max => $max, directive => $directive, reason => $reason);
4485759b3d2Safresh1}
4495759b3d2Safresh1
4505759b3d2Safresh1sub bail {
4515759b3d2Safresh1    my ($self, $reason) = @_;
4525759b3d2Safresh1    $self->send_event('Bail', reason => $reason);
4535759b3d2Safresh1}
4545759b3d2Safresh1
4555759b3d2Safresh1sub _parse_event {
4565759b3d2Safresh1    my $self = shift;
4575759b3d2Safresh1    my $event = shift;
4585759b3d2Safresh1
4595759b3d2Safresh1    my $pkg;
4605759b3d2Safresh1    if ($event =~ m/^\+(.*)/) {
4615759b3d2Safresh1        $pkg = $1;
4625759b3d2Safresh1    }
4635759b3d2Safresh1    else {
4645759b3d2Safresh1        $pkg = "Test2::Event::$event";
4655759b3d2Safresh1    }
4665759b3d2Safresh1
4675759b3d2Safresh1    unless ($LOADED{$pkg}) {
4685759b3d2Safresh1        my $file = pkg_to_file($pkg);
4695759b3d2Safresh1        my ($ok, $err) = try { require $file };
4705759b3d2Safresh1        $self->throw("Could not load event module '$pkg': $err")
4715759b3d2Safresh1            unless $ok;
4725759b3d2Safresh1
4735759b3d2Safresh1        $LOADED{$pkg} = $pkg;
4745759b3d2Safresh1    }
4755759b3d2Safresh1
4765759b3d2Safresh1    confess "'$pkg' is not a subclass of 'Test2::Event'"
4775759b3d2Safresh1        unless $pkg->isa('Test2::Event');
4785759b3d2Safresh1
4795759b3d2Safresh1    $LOADED{$event} = $pkg;
4805759b3d2Safresh1
4815759b3d2Safresh1    return $pkg;
4825759b3d2Safresh1}
4835759b3d2Safresh1
4845759b3d2Safresh11;
4855759b3d2Safresh1
4865759b3d2Safresh1__END__
4875759b3d2Safresh1
4885759b3d2Safresh1=pod
4895759b3d2Safresh1
4905759b3d2Safresh1=encoding UTF-8
4915759b3d2Safresh1
4925759b3d2Safresh1=head1 NAME
4935759b3d2Safresh1
4945759b3d2Safresh1Test2::API::Context - Object to represent a testing context.
4955759b3d2Safresh1
4965759b3d2Safresh1=head1 DESCRIPTION
4975759b3d2Safresh1
4985759b3d2Safresh1The context object is the primary interface for authors of testing tools
4995759b3d2Safresh1written with L<Test2>. The context object represents the context in
5005759b3d2Safresh1which a test takes place (File and Line Number), and provides a quick way to
5015759b3d2Safresh1generate events from that context. The context object also takes care of
5025759b3d2Safresh1sending events to the correct L<Test2::Hub> instance.
5035759b3d2Safresh1
5045759b3d2Safresh1=head1 SYNOPSIS
5055759b3d2Safresh1
5065759b3d2Safresh1In general you will not be creating contexts directly. To obtain a context you
5075759b3d2Safresh1should always use C<context()> which is exported by the L<Test2::API> module.
5085759b3d2Safresh1
5095759b3d2Safresh1    use Test2::API qw/context/;
5105759b3d2Safresh1
5115759b3d2Safresh1    sub my_ok {
5125759b3d2Safresh1        my ($bool, $name) = @_;
5135759b3d2Safresh1        my $ctx = context();
514f3efcd01Safresh1
515f3efcd01Safresh1        if ($bool) {
516f3efcd01Safresh1            $ctx->pass($name);
517f3efcd01Safresh1        }
518f3efcd01Safresh1        else {
519f3efcd01Safresh1            $ctx->fail($name);
520f3efcd01Safresh1        }
521f3efcd01Safresh1
5225759b3d2Safresh1        $ctx->release; # You MUST do this!
5235759b3d2Safresh1        return $bool;
5245759b3d2Safresh1    }
5255759b3d2Safresh1
5265759b3d2Safresh1Context objects make it easy to wrap other tools that also use context. Once
5275759b3d2Safresh1you grab a context, any tool you call before releasing your context will
5285759b3d2Safresh1inherit it:
5295759b3d2Safresh1
5305759b3d2Safresh1    sub wrapper {
5315759b3d2Safresh1        my ($bool, $name) = @_;
5325759b3d2Safresh1        my $ctx = context();
5335759b3d2Safresh1        $ctx->diag("wrapping my_ok");
5345759b3d2Safresh1
5355759b3d2Safresh1        my $out = my_ok($bool, $name);
5365759b3d2Safresh1        $ctx->release; # You MUST do this!
5375759b3d2Safresh1        return $out;
5385759b3d2Safresh1    }
5395759b3d2Safresh1
5405759b3d2Safresh1=head1 CRITICAL DETAILS
5415759b3d2Safresh1
5425759b3d2Safresh1=over 4
5435759b3d2Safresh1
5445759b3d2Safresh1=item you MUST always use the context() sub from Test2::API
5455759b3d2Safresh1
5465759b3d2Safresh1Creating your own context via C<< Test2::API::Context->new() >> will almost never
5475759b3d2Safresh1produce a desirable result. Use C<context()> which is exported by L<Test2::API>.
5485759b3d2Safresh1
5495759b3d2Safresh1There are a handful of cases where a tool author may want to create a new
5505759b3d2Safresh1context by hand, which is why the C<new> method exists. Unless you really know
5515759b3d2Safresh1what you are doing you should avoid this.
5525759b3d2Safresh1
5535759b3d2Safresh1=item You MUST always release the context when done with it
5545759b3d2Safresh1
5555759b3d2Safresh1Releasing the context tells the system you are done with it. This gives it a
5565759b3d2Safresh1chance to run any necessary callbacks or cleanup tasks. If you forget to
5575759b3d2Safresh1release the context it will try to detect the problem and warn you about it.
5585759b3d2Safresh1
5595759b3d2Safresh1=item You MUST NOT pass context objects around
5605759b3d2Safresh1
5615759b3d2Safresh1When you obtain a context object it is made specifically for your tool and any
5625759b3d2Safresh1tools nested within. If you pass a context around you run the risk of polluting
5635759b3d2Safresh1other tools with incorrect context information.
5645759b3d2Safresh1
5655759b3d2Safresh1If you are certain that you want a different tool to use the same context you
5665759b3d2Safresh1may pass it a snapshot. C<< $ctx->snapshot >> will give you a shallow clone of
5675759b3d2Safresh1the context that is safe to pass around or store.
5685759b3d2Safresh1
5695759b3d2Safresh1=item You MUST NOT store or cache a context for later
5705759b3d2Safresh1
5715759b3d2Safresh1As long as a context exists for a given hub, all tools that try to get a
5725759b3d2Safresh1context will get the existing instance. If you try to store the context you
5735759b3d2Safresh1will pollute other tools with incorrect context information.
5745759b3d2Safresh1
5755759b3d2Safresh1If you are certain that you want to save the context for later, you can use a
5765759b3d2Safresh1snapshot. C<< $ctx->snapshot >> will give you a shallow clone of the context
5775759b3d2Safresh1that is safe to pass around or store.
5785759b3d2Safresh1
5795759b3d2Safresh1C<context()> has some mechanisms to protect you if you do cause a context to
5805759b3d2Safresh1persist beyond the scope in which it was obtained. In practice you should not
5815759b3d2Safresh1rely on these protections, and they are fairly noisy with warnings.
5825759b3d2Safresh1
5835759b3d2Safresh1=item You SHOULD obtain your context as soon as possible in a given tool
5845759b3d2Safresh1
5855759b3d2Safresh1You never know what tools you call from within your own tool will need a
5865759b3d2Safresh1context. Obtaining the context early ensures that nested tools can find the
5875759b3d2Safresh1context you want them to find.
5885759b3d2Safresh1
5895759b3d2Safresh1=back
5905759b3d2Safresh1
5915759b3d2Safresh1=head1 METHODS
5925759b3d2Safresh1
5935759b3d2Safresh1=over 4
5945759b3d2Safresh1
5955759b3d2Safresh1=item $ctx->done_testing;
5965759b3d2Safresh1
5975759b3d2Safresh1Note that testing is finished. If no plan has been set this will generate a
5985759b3d2Safresh1Plan event.
5995759b3d2Safresh1
6005759b3d2Safresh1=item $clone = $ctx->snapshot()
6015759b3d2Safresh1
6025759b3d2Safresh1This will return a shallow clone of the context. The shallow clone is safe to
6035759b3d2Safresh1store for later.
6045759b3d2Safresh1
6055759b3d2Safresh1=item $ctx->release()
6065759b3d2Safresh1
6075759b3d2Safresh1This will release the context. This runs cleanup tasks, and several important
6085759b3d2Safresh1hooks. It will also restore C<$!>, C<$?>, and C<$@> to what they were when the
6095759b3d2Safresh1context was created.
6105759b3d2Safresh1
6115759b3d2Safresh1B<Note:> If a context is acquired more than once an internal refcount is kept.
6125759b3d2Safresh1C<release()> decrements the ref count, none of the other actions of
6135759b3d2Safresh1C<release()> will occur unless the refcount hits 0. This means only the last
6145759b3d2Safresh1call to C<release()> will reset C<$?>, C<$!>, C<$@>, and run the cleanup tasks.
6155759b3d2Safresh1
6165759b3d2Safresh1=item $ctx->throw($message)
6175759b3d2Safresh1
6185759b3d2Safresh1This will throw an exception reporting to the file and line number of the
6195759b3d2Safresh1context. This will also release the context for you.
6205759b3d2Safresh1
6215759b3d2Safresh1=item $ctx->alert($message)
6225759b3d2Safresh1
6235759b3d2Safresh1This will issue a warning from the file and line number of the context.
6245759b3d2Safresh1
6255759b3d2Safresh1=item $stack = $ctx->stack()
6265759b3d2Safresh1
6275759b3d2Safresh1This will return the L<Test2::API::Stack> instance the context used to find
6285759b3d2Safresh1the current hub.
6295759b3d2Safresh1
6305759b3d2Safresh1=item $hub = $ctx->hub()
6315759b3d2Safresh1
6325759b3d2Safresh1This will return the L<Test2::Hub> instance the context recognizes as the
6335759b3d2Safresh1current one to which all events should be sent.
6345759b3d2Safresh1
6355759b3d2Safresh1=item $dbg = $ctx->trace()
6365759b3d2Safresh1
6375759b3d2Safresh1This will return the L<Test2::EventFacet::Trace> instance used by the context.
6385759b3d2Safresh1
6395759b3d2Safresh1=item $ctx->do_in_context(\&code, @args);
6405759b3d2Safresh1
6415759b3d2Safresh1Sometimes you have a context that is not current, and you want things to use it
6425759b3d2Safresh1as the current one. In these cases you can call
6435759b3d2Safresh1C<< $ctx->do_in_context(sub { ... }) >>. The codeblock will be run, and
6445759b3d2Safresh1anything inside of it that looks for a context will find the one on which the
6455759b3d2Safresh1method was called.
6465759b3d2Safresh1
6475759b3d2Safresh1This B<DOES NOT> affect context on other hubs, only the hub used by the context
6485759b3d2Safresh1will be affected.
6495759b3d2Safresh1
6505759b3d2Safresh1    my $ctx = ...;
6515759b3d2Safresh1    $ctx->do_in_context(sub {
6525759b3d2Safresh1        my $ctx = context(); # returns the $ctx the sub is called on
6535759b3d2Safresh1    });
6545759b3d2Safresh1
6555759b3d2Safresh1B<Note:> The context will actually be cloned, the clone will be used instead of
6565759b3d2Safresh1the original. This allows the thread id, process id, and error variables to be correct without
6575759b3d2Safresh1modifying the original context.
6585759b3d2Safresh1
6595759b3d2Safresh1=item $ctx->restore_error_vars()
6605759b3d2Safresh1
6615759b3d2Safresh1This will set C<$!>, C<$?>, and C<$@> to what they were when the context was
6625759b3d2Safresh1created. There is no localization or anything done here, calling this method
6635759b3d2Safresh1will actually set these vars.
6645759b3d2Safresh1
6655759b3d2Safresh1=item $! = $ctx->errno()
6665759b3d2Safresh1
6675759b3d2Safresh1The (numeric) value of C<$!> when the context was created.
6685759b3d2Safresh1
6695759b3d2Safresh1=item $? = $ctx->child_error()
6705759b3d2Safresh1
6715759b3d2Safresh1The value of C<$?> when the context was created.
6725759b3d2Safresh1
6735759b3d2Safresh1=item $@ = $ctx->eval_error()
6745759b3d2Safresh1
6755759b3d2Safresh1The value of C<$@> when the context was created.
6765759b3d2Safresh1
6775759b3d2Safresh1=back
6785759b3d2Safresh1
6795759b3d2Safresh1=head2 EVENT PRODUCTION METHODS
6805759b3d2Safresh1
6815759b3d2Safresh1B<Which one do I use?>
6825759b3d2Safresh1
6835759b3d2Safresh1The C<pass*> and C<fail*> are optimal if they meet your situation, using one of
6845759b3d2Safresh1them will always be the most optimal. That said they are optimal by eliminating
6855759b3d2Safresh1many features.
6865759b3d2Safresh1
6875759b3d2Safresh1Method such as C<ok>, and C<note> are shortcuts for generating common 1-task
6885759b3d2Safresh1events based on the old API, however they are forward compatible, and easy to
6895759b3d2Safresh1use. If these meet your needs then go ahead and use them, but please check back
6905759b3d2Safresh1often for alternatives that may be added.
6915759b3d2Safresh1
6925759b3d2Safresh1If you want to generate new style events, events that do many things at once,
6935759b3d2Safresh1then you want the C<*ev2*> methods. These let you directly specify which facets
6945759b3d2Safresh1you wish to use.
6955759b3d2Safresh1
6965759b3d2Safresh1=over 4
6975759b3d2Safresh1
6985759b3d2Safresh1=item $event = $ctx->pass()
6995759b3d2Safresh1
7005759b3d2Safresh1=item $event = $ctx->pass($name)
7015759b3d2Safresh1
7025759b3d2Safresh1This will send and return an L<Test2::Event::Pass> event. You may optionally
7035759b3d2Safresh1provide a C<$name> for the assertion.
7045759b3d2Safresh1
7055759b3d2Safresh1The L<Test2::Event::Pass> is a specially crafted and optimized event, using
7065759b3d2Safresh1this will help the performance of passing tests.
7075759b3d2Safresh1
7085759b3d2Safresh1=item $true = $ctx->pass_and_release()
7095759b3d2Safresh1
7105759b3d2Safresh1=item $true = $ctx->pass_and_release($name)
7115759b3d2Safresh1
7125759b3d2Safresh1This is a combination of C<pass()> and C<release()>. You can use this if you do
7135759b3d2Safresh1not plan to do anything with the context after sending the event. This helps
7145759b3d2Safresh1write more clear and compact code.
7155759b3d2Safresh1
7165759b3d2Safresh1    sub shorthand {
7175759b3d2Safresh1        my ($bool, $name) = @_;
7185759b3d2Safresh1        my $ctx = context();
7195759b3d2Safresh1        return $ctx->pass_and_release($name) if $bool;
7205759b3d2Safresh1
7215759b3d2Safresh1        ... Handle a failure ...
7225759b3d2Safresh1    }
7235759b3d2Safresh1
7245759b3d2Safresh1    sub longform {
7255759b3d2Safresh1        my ($bool, $name) = @_;
7265759b3d2Safresh1        my $ctx = context();
7275759b3d2Safresh1
7285759b3d2Safresh1        if ($bool) {
7295759b3d2Safresh1            $ctx->pass($name);
7305759b3d2Safresh1            $ctx->release;
7315759b3d2Safresh1            return 1;
7325759b3d2Safresh1        }
7335759b3d2Safresh1
7345759b3d2Safresh1        ... Handle a failure ...
7355759b3d2Safresh1    }
7365759b3d2Safresh1
7375759b3d2Safresh1=item my $event = $ctx->fail()
7385759b3d2Safresh1
7395759b3d2Safresh1=item my $event = $ctx->fail($name)
7405759b3d2Safresh1
7415759b3d2Safresh1=item my $event = $ctx->fail($name, @diagnostics)
7425759b3d2Safresh1
7435759b3d2Safresh1This lets you send an L<Test2::Event::Fail> event. You may optionally provide a
7445759b3d2Safresh1C<$name> and C<@diagnostics> messages.
7455759b3d2Safresh1
746f3efcd01Safresh1Diagnostics messages can be simple strings, data structures, or instances of
747f3efcd01Safresh1L<Test2::EventFacet::Info::Table> (which are converted inline into the
748f3efcd01Safresh1L<Test2::EventFacet::Info> structure).
749f3efcd01Safresh1
7505759b3d2Safresh1=item my $false = $ctx->fail_and_release()
7515759b3d2Safresh1
7525759b3d2Safresh1=item my $false = $ctx->fail_and_release($name)
7535759b3d2Safresh1
7545759b3d2Safresh1=item my $false = $ctx->fail_and_release($name, @diagnostics)
7555759b3d2Safresh1
7565759b3d2Safresh1This is a combination of C<fail()> and C<release()>. This can be used to write
7575759b3d2Safresh1clearer and shorter code.
7585759b3d2Safresh1
7595759b3d2Safresh1    sub shorthand {
7605759b3d2Safresh1        my ($bool, $name) = @_;
7615759b3d2Safresh1        my $ctx = context();
7625759b3d2Safresh1        return $ctx->fail_and_release($name) unless $bool;
7635759b3d2Safresh1
7645759b3d2Safresh1        ... Handle a success ...
7655759b3d2Safresh1    }
7665759b3d2Safresh1
7675759b3d2Safresh1    sub longform {
7685759b3d2Safresh1        my ($bool, $name) = @_;
7695759b3d2Safresh1        my $ctx = context();
7705759b3d2Safresh1
7715759b3d2Safresh1        unless ($bool) {
7725759b3d2Safresh1            $ctx->pass($name);
7735759b3d2Safresh1            $ctx->release;
7745759b3d2Safresh1            return 1;
7755759b3d2Safresh1        }
7765759b3d2Safresh1
7775759b3d2Safresh1        ... Handle a success ...
7785759b3d2Safresh1    }
7795759b3d2Safresh1
7805759b3d2Safresh1
7815759b3d2Safresh1=item $event = $ctx->ok($bool, $name)
7825759b3d2Safresh1
7835759b3d2Safresh1=item $event = $ctx->ok($bool, $name, \@on_fail)
7845759b3d2Safresh1
7855759b3d2Safresh1B<NOTE:> Use of this method is discouraged in favor of C<pass()> and C<fail()>
7865759b3d2Safresh1which produce L<Test2::Event::Pass> and L<Test2::Event::Fail> events. These
7875759b3d2Safresh1newer event types are faster and less crufty.
7885759b3d2Safresh1
7895759b3d2Safresh1This will create an L<Test2::Event::Ok> object for you. If C<$bool> is false
7905759b3d2Safresh1then an L<Test2::Event::Diag> event will be sent as well with details about the
7915759b3d2Safresh1failure. If you do not want automatic diagnostics you should use the
7925759b3d2Safresh1C<send_event()> method directly.
7935759b3d2Safresh1
7945759b3d2Safresh1The third argument C<\@on_fail>) is an optional set of diagnostics to be sent in
795f3efcd01Safresh1the event of a test failure. Unlike with C<fail()> these diagnostics must be
796f3efcd01Safresh1plain strings, data structures are not supported.
7975759b3d2Safresh1
7985759b3d2Safresh1=item $event = $ctx->note($message)
7995759b3d2Safresh1
8005759b3d2Safresh1Send an L<Test2::Event::Note>. This event prints a message to STDOUT.
8015759b3d2Safresh1
8025759b3d2Safresh1=item $event = $ctx->diag($message)
8035759b3d2Safresh1
8045759b3d2Safresh1Send an L<Test2::Event::Diag>. This event prints a message to STDERR.
8055759b3d2Safresh1
8065759b3d2Safresh1=item $event = $ctx->plan($max)
8075759b3d2Safresh1
8085759b3d2Safresh1=item $event = $ctx->plan(0, 'SKIP', $reason)
8095759b3d2Safresh1
8105759b3d2Safresh1This can be used to send an L<Test2::Event::Plan> event. This event
8115759b3d2Safresh1usually takes either a number of tests you expect to run. Optionally you can
8125759b3d2Safresh1set the expected count to 0 and give the 'SKIP' directive with a reason to
8135759b3d2Safresh1cause all tests to be skipped.
8145759b3d2Safresh1
8155759b3d2Safresh1=item $event = $ctx->skip($name, $reason);
8165759b3d2Safresh1
8175759b3d2Safresh1Send an L<Test2::Event::Skip> event.
8185759b3d2Safresh1
8195759b3d2Safresh1=item $event = $ctx->bail($reason)
8205759b3d2Safresh1
8215759b3d2Safresh1This sends an L<Test2::Event::Bail> event. This event will completely
8225759b3d2Safresh1terminate all testing.
8235759b3d2Safresh1
8245759b3d2Safresh1=item $event = $ctx->send_ev2(%facets)
8255759b3d2Safresh1
8265759b3d2Safresh1This lets you build and send a V2 event directly from facets. The event is
8275759b3d2Safresh1returned after it is sent.
8285759b3d2Safresh1
8295759b3d2Safresh1This example sends a single assertion, a note (comment for stdout in
8305759b3d2Safresh1Test::Builder talk) and sets the plan to 1.
8315759b3d2Safresh1
8325759b3d2Safresh1    my $event = $ctx->send_event(
8335759b3d2Safresh1        plan   => {count => 1},
8345759b3d2Safresh1        assert => {pass  => 1, details => "A passing assert"},
8355759b3d2Safresh1        info => [{tag => 'NOTE', details => "This is a note"}],
8365759b3d2Safresh1    );
8375759b3d2Safresh1
8385759b3d2Safresh1=item $event = $ctx->build_e2(%facets)
8395759b3d2Safresh1
8405759b3d2Safresh1This is the same as C<send_ev2()>, except it builds and returns the event
8415759b3d2Safresh1without sending it.
8425759b3d2Safresh1
8435759b3d2Safresh1=item $event = $ctx->send_ev2_and_release($Type, %parameters)
8445759b3d2Safresh1
8455759b3d2Safresh1This is a combination of C<send_ev2()> and C<release()>.
8465759b3d2Safresh1
8475759b3d2Safresh1    sub shorthand {
8485759b3d2Safresh1        my $ctx = context();
8495759b3d2Safresh1        return $ctx->send_ev2_and_release(assert => {pass => 1, details => 'foo'});
8505759b3d2Safresh1    }
8515759b3d2Safresh1
8525759b3d2Safresh1    sub longform {
8535759b3d2Safresh1        my $ctx = context();
8545759b3d2Safresh1        my $event = $ctx->send_ev2(assert => {pass => 1, details => 'foo'});
8555759b3d2Safresh1        $ctx->release;
8565759b3d2Safresh1        return $event;
8575759b3d2Safresh1    }
8585759b3d2Safresh1
8595759b3d2Safresh1=item $event = $ctx->send_event($Type, %parameters)
8605759b3d2Safresh1
8615759b3d2Safresh1B<It is better to use send_ev2() in new code.>
8625759b3d2Safresh1
8635759b3d2Safresh1This lets you build and send an event of any type. The C<$Type> argument should
8645759b3d2Safresh1be the event package name with C<Test2::Event::> left off, or a fully
8655759b3d2Safresh1qualified package name prefixed with a '+'. The event is returned after it is
8665759b3d2Safresh1sent.
8675759b3d2Safresh1
8685759b3d2Safresh1    my $event = $ctx->send_event('Ok', ...);
8695759b3d2Safresh1
8705759b3d2Safresh1or
8715759b3d2Safresh1
8725759b3d2Safresh1    my $event = $ctx->send_event('+Test2::Event::Ok', ...);
8735759b3d2Safresh1
8745759b3d2Safresh1=item $event = $ctx->build_event($Type, %parameters)
8755759b3d2Safresh1
8765759b3d2Safresh1B<It is better to use build_ev2() in new code.>
8775759b3d2Safresh1
8785759b3d2Safresh1This is the same as C<send_event()>, except it builds and returns the event
8795759b3d2Safresh1without sending it.
8805759b3d2Safresh1
8815759b3d2Safresh1=item $event = $ctx->send_event_and_release($Type, %parameters)
8825759b3d2Safresh1
8835759b3d2Safresh1B<It is better to use send_ev2_and_release() in new code.>
8845759b3d2Safresh1
8855759b3d2Safresh1This is a combination of C<send_event()> and C<release()>.
8865759b3d2Safresh1
8875759b3d2Safresh1    sub shorthand {
8885759b3d2Safresh1        my $ctx = context();
8895759b3d2Safresh1        return $ctx->send_event_and_release(Pass => { name => 'foo' });
8905759b3d2Safresh1    }
8915759b3d2Safresh1
8925759b3d2Safresh1    sub longform {
8935759b3d2Safresh1        my $ctx = context();
8945759b3d2Safresh1        my $event = $ctx->send_event(Pass => { name => 'foo' });
8955759b3d2Safresh1        $ctx->release;
8965759b3d2Safresh1        return $event;
8975759b3d2Safresh1    }
8985759b3d2Safresh1
8995759b3d2Safresh1=back
9005759b3d2Safresh1
9015759b3d2Safresh1=head1 HOOKS
9025759b3d2Safresh1
9035759b3d2Safresh1There are 2 types of hooks, init hooks, and release hooks. As the names
9045759b3d2Safresh1suggest, these hooks are triggered when contexts are created or released.
9055759b3d2Safresh1
9065759b3d2Safresh1=head2 INIT HOOKS
9075759b3d2Safresh1
9085759b3d2Safresh1These are called whenever a context is initialized. That means when a new
9095759b3d2Safresh1instance is created. These hooks are B<NOT> called every time something
9105759b3d2Safresh1requests a context, just when a new one is created.
9115759b3d2Safresh1
9125759b3d2Safresh1=head3 GLOBAL
9135759b3d2Safresh1
9145759b3d2Safresh1This is how you add a global init callback. Global callbacks happen for every
9155759b3d2Safresh1context for any hub or stack.
9165759b3d2Safresh1
9175759b3d2Safresh1    Test2::API::test2_add_callback_context_init(sub {
9185759b3d2Safresh1        my $ctx = shift;
9195759b3d2Safresh1        ...
9205759b3d2Safresh1    });
9215759b3d2Safresh1
9225759b3d2Safresh1=head3 PER HUB
9235759b3d2Safresh1
9245759b3d2Safresh1This is how you add an init callback for all contexts created for a given hub.
9255759b3d2Safresh1These callbacks will not run for other hubs.
9265759b3d2Safresh1
9275759b3d2Safresh1    $hub->add_context_init(sub {
9285759b3d2Safresh1        my $ctx = shift;
9295759b3d2Safresh1        ...
9305759b3d2Safresh1    });
9315759b3d2Safresh1
9325759b3d2Safresh1=head3 PER CONTEXT
9335759b3d2Safresh1
9345759b3d2Safresh1This is how you specify an init hook that will only run if your call to
9355759b3d2Safresh1C<context()> generates a new context. The callback will be ignored if
9365759b3d2Safresh1C<context()> is returning an existing context.
9375759b3d2Safresh1
9385759b3d2Safresh1    my $ctx = context(on_init => sub {
9395759b3d2Safresh1        my $ctx = shift;
9405759b3d2Safresh1        ...
9415759b3d2Safresh1    });
9425759b3d2Safresh1
9435759b3d2Safresh1=head2 RELEASE HOOKS
9445759b3d2Safresh1
9455759b3d2Safresh1These are called whenever a context is released. That means when the last
9465759b3d2Safresh1reference to the instance is about to be destroyed. These hooks are B<NOT>
9475759b3d2Safresh1called every time C<< $ctx->release >> is called.
9485759b3d2Safresh1
9495759b3d2Safresh1=head3 GLOBAL
9505759b3d2Safresh1
9515759b3d2Safresh1This is how you add a global release callback. Global callbacks happen for every
9525759b3d2Safresh1context for any hub or stack.
9535759b3d2Safresh1
9545759b3d2Safresh1    Test2::API::test2_add_callback_context_release(sub {
9555759b3d2Safresh1        my $ctx = shift;
9565759b3d2Safresh1        ...
9575759b3d2Safresh1    });
9585759b3d2Safresh1
9595759b3d2Safresh1=head3 PER HUB
9605759b3d2Safresh1
9615759b3d2Safresh1This is how you add a release callback for all contexts created for a given
9625759b3d2Safresh1hub. These callbacks will not run for other hubs.
9635759b3d2Safresh1
9645759b3d2Safresh1    $hub->add_context_release(sub {
9655759b3d2Safresh1        my $ctx = shift;
9665759b3d2Safresh1        ...
9675759b3d2Safresh1    });
9685759b3d2Safresh1
9695759b3d2Safresh1=head3 PER CONTEXT
9705759b3d2Safresh1
9715759b3d2Safresh1This is how you add release callbacks directly to a context. The callback will
9725759b3d2Safresh1B<ALWAYS> be added to the context that gets returned, it does not matter if a
9735759b3d2Safresh1new one is generated, or if an existing one is returned.
9745759b3d2Safresh1
9755759b3d2Safresh1    my $ctx = context(on_release => sub {
9765759b3d2Safresh1        my $ctx = shift;
9775759b3d2Safresh1        ...
9785759b3d2Safresh1    });
9795759b3d2Safresh1
9805759b3d2Safresh1=head1 THIRD PARTY META-DATA
9815759b3d2Safresh1
9825759b3d2Safresh1This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
9835759b3d2Safresh1way for you to attach meta-data to instances of this class. This is useful for
9845759b3d2Safresh1tools, plugins, and other extensions.
9855759b3d2Safresh1
9865759b3d2Safresh1=head1 SOURCE
9875759b3d2Safresh1
9885759b3d2Safresh1The source code repository for Test2 can be found at
989*5486feefSafresh1L<https://github.com/Test-More/test-more/>.
9905759b3d2Safresh1
9915759b3d2Safresh1=head1 MAINTAINERS
9925759b3d2Safresh1
9935759b3d2Safresh1=over 4
9945759b3d2Safresh1
9955759b3d2Safresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt>
9965759b3d2Safresh1
9975759b3d2Safresh1=back
9985759b3d2Safresh1
9995759b3d2Safresh1=head1 AUTHORS
10005759b3d2Safresh1
10015759b3d2Safresh1=over 4
10025759b3d2Safresh1
10035759b3d2Safresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt>
10045759b3d2Safresh1
10055759b3d2Safresh1=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>
10065759b3d2Safresh1
10075759b3d2Safresh1=back
10085759b3d2Safresh1
10095759b3d2Safresh1=head1 COPYRIGHT
10105759b3d2Safresh1
1011256a93a4Safresh1Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
10125759b3d2Safresh1
10135759b3d2Safresh1This program is free software; you can redistribute it and/or
10145759b3d2Safresh1modify it under the same terms as Perl itself.
10155759b3d2Safresh1
1016*5486feefSafresh1See L<https://dev.perl.org/licenses/>
10175759b3d2Safresh1
10185759b3d2Safresh1=cut
1019