15759b3d2Safresh1use strict; 25759b3d2Safresh1use warnings; 35759b3d2Safresh1use Test2::Tools::Tiny; 45759b3d2Safresh1 55759b3d2Safresh1use Test2::Hub::Subtest; 65759b3d2Safresh1use Test2::Util qw/get_tid/; 75759b3d2Safresh1use Carp qw/croak/; 85759b3d2Safresh1 95759b3d2Safresh1my %TODO; 105759b3d2Safresh1 115759b3d2Safresh1sub def { 125759b3d2Safresh1 my ($func, @args) = @_; 135759b3d2Safresh1 145759b3d2Safresh1 my @caller = caller(0); 155759b3d2Safresh1 165759b3d2Safresh1 $TODO{$caller[0]} ||= []; 175759b3d2Safresh1 push @{$TODO{$caller[0]}} => [$func, \@args, \@caller]; 185759b3d2Safresh1} 195759b3d2Safresh1 205759b3d2Safresh1sub do_def { 215759b3d2Safresh1 my $for = caller; 225759b3d2Safresh1 my $tests = delete $TODO{$for} or croak "No tests to run!"; 235759b3d2Safresh1 245759b3d2Safresh1 for my $test (@$tests) { 255759b3d2Safresh1 my ($func, $args, $caller) = @$test; 265759b3d2Safresh1 275759b3d2Safresh1 my ($pkg, $file, $line) = @$caller; 285759b3d2Safresh1 295759b3d2Safresh1# Note: The '&' below is to bypass the prototype, which is important here. 305759b3d2Safresh1 eval <<" EOT" or die $@; 315759b3d2Safresh1package $pkg; 325759b3d2Safresh1# line $line "(eval in DeferredTests) $file" 335759b3d2Safresh1\&$func(\@\$args); 345759b3d2Safresh11; 355759b3d2Safresh1 EOT 365759b3d2Safresh1 } 375759b3d2Safresh1} 385759b3d2Safresh1 395759b3d2Safresh1my $ran = 0; 405759b3d2Safresh1my $event; 415759b3d2Safresh1 425759b3d2Safresh1my $one = Test2::Hub::Subtest->new( 435759b3d2Safresh1 nested => 3, 445759b3d2Safresh1); 455759b3d2Safresh1 46*5486feefSafresh1ok($one->isa('Test2::Hub'), "inheritance"); 475759b3d2Safresh1 485759b3d2Safresh1{ 495759b3d2Safresh1 no warnings 'redefine'; 505759b3d2Safresh1 local *Test2::Hub::process = sub { $ran++; (undef, $event) = @_; 'P!' }; 515759b3d2Safresh1 use warnings; 525759b3d2Safresh1 535759b3d2Safresh1 my $ok = Test2::Event::Ok->new( 545759b3d2Safresh1 pass => 1, 555759b3d2Safresh1 name => 'blah', 565759b3d2Safresh1 trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'xxx']), 575759b3d2Safresh1 ); 585759b3d2Safresh1 595759b3d2Safresh1 def is => ($one->process($ok), 'P!', "processed"); 605759b3d2Safresh1 def is => ($ran, 1, "ran the mocked process"); 615759b3d2Safresh1 def is => ($event, $ok, "got our event"); 625759b3d2Safresh1 def is => ($one->bailed_out, undef, "did not bail"); 635759b3d2Safresh1 645759b3d2Safresh1 $ran = 0; 655759b3d2Safresh1 $event = undef; 665759b3d2Safresh1 675759b3d2Safresh1 my $bail = Test2::Event::Bail->new( 685759b3d2Safresh1 message => 'blah', 695759b3d2Safresh1 trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'xxx']), 705759b3d2Safresh1 ); 715759b3d2Safresh1 725759b3d2Safresh1 def is => ($one->process($bail), 'P!', "processed"); 735759b3d2Safresh1 def is => ($ran, 1, "ran the mocked process"); 745759b3d2Safresh1 def is => ($event, $bail, "got our event"); 755759b3d2Safresh1} 765759b3d2Safresh1 775759b3d2Safresh1do_def; 785759b3d2Safresh1 795759b3d2Safresh1my $skip = Test2::Event::Plan->new( 805759b3d2Safresh1 trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__], pid => $$, tid => get_tid), 815759b3d2Safresh1 directive => 'SKIP', 825759b3d2Safresh1 reason => 'foo', 835759b3d2Safresh1); 845759b3d2Safresh1 855759b3d2Safresh1$ran = 0; 865759b3d2Safresh1T2_SUBTEST_WRAPPER: { 875759b3d2Safresh1 $ran++; 885759b3d2Safresh1 $one->terminate(100, $skip); 895759b3d2Safresh1 $ran++; 905759b3d2Safresh1} 915759b3d2Safresh1is($ran, 1, "did not get past the terminate"); 925759b3d2Safresh1 935759b3d2Safresh1$ran = 0; 945759b3d2Safresh1T2_SUBTEST_WRAPPER: { 955759b3d2Safresh1 $ran++; 965759b3d2Safresh1 $one->send($skip); 975759b3d2Safresh1 $ran++; 985759b3d2Safresh1} 995759b3d2Safresh1is($ran, 1, "did not get past the terminate"); 1005759b3d2Safresh1 1015759b3d2Safresh1$one->reset_state; 1025759b3d2Safresh1$one->set_manual_skip_all(1); 1035759b3d2Safresh1 1045759b3d2Safresh1$ran = 0; 1055759b3d2Safresh1T2_SUBTEST_WRAPPER: { 1065759b3d2Safresh1 $ran++; 1075759b3d2Safresh1 $one->terminate(100, $skip); 1085759b3d2Safresh1 $ran++; 1095759b3d2Safresh1} 1105759b3d2Safresh1is($ran, 2, "did not automatically abort"); 1115759b3d2Safresh1 1125759b3d2Safresh1$one->reset_state; 1135759b3d2Safresh1$ran = 0; 1145759b3d2Safresh1T2_SUBTEST_WRAPPER: { 1155759b3d2Safresh1 $ran++; 1165759b3d2Safresh1 $one->send($skip); 1175759b3d2Safresh1 $ran++; 1185759b3d2Safresh1} 1195759b3d2Safresh1is($ran, 2, "did not automatically abort"); 1205759b3d2Safresh1 1215759b3d2Safresh1done_testing; 122