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