1use strict; 2use warnings; 3 4use Test2::Tools::Tiny; 5use Test2::EventFacet::Trace; 6 7use Test2::API qw/context intercept/; 8 9sub tool { 10 my $ctx = context(); 11 my $e = $ctx->send_event('Generic', @_); 12 $ctx->release; 13 return $e; 14} 15 16my $e; 17intercept { $e = tool() }; 18 19ok($e, "got event"); 20ok($e->isa('Test2::Event'), "It is an event"); 21ok($e->isa('Test2::Event::Generic'), "It is an event"); 22delete $e->{trace}; 23is_deeply( 24 $e, 25 { 26 causes_fail => 0, 27 increments_count => 0, 28 diagnostics => 0, 29 no_display => 0, 30 _eid => $e->eid, 31 hubs => [ 32 { 33 'buffered' => 0, 34 'details' => 'Test2::Hub::Interceptor', 35 'hid' => $e->hubs->[0]->{hid}, 36 'ipc' => 0, 37 'nested' => 0, 38 'pid' => $$, 39 'tid' => 0, 40 $e->hubs->[0]->{uuid} ? (uuid => $e->hubs->[0]->{uuid}) : (uuid => undef), 41 } 42 ], 43 $e->uuid ? (uuid => $e->uuid) : (), 44 }, 45 "Defaults" 46); 47 48for my $f (qw/causes_fail increments_count diagnostics no_display/) { 49 is($e->$f, 0, "'$f' is 0"); 50 is_deeply([$e->$f], [0], "'$f' is 0 is list context as well"); 51 52 my $set = "set_$f"; 53 $e->$set(1); 54 is($e->$f, 1, "'$f' was set to 1"); 55} 56 57for my $f (qw/callback terminate global sets_plan/) { 58 is($e->$f, undef, "no $f"); 59 is_deeply([$e->$f], [], "$f is empty in list context"); 60} 61 62like($e->summary, qr/Test2::Event::Generic/, "Got base class summary"); 63 64like( 65 exception { $e->set_sets_plan('bad') }, 66 qr/'sets_plan' must be an array reference/, 67 "Must provide an arrayref" 68); 69 70$e->set_sets_plan([0, skip => 'cause']); 71is_deeply([$e->sets_plan], [0, skip => 'cause'], "sets_plan returns a list, not a ref"); 72$e->set_sets_plan(undef); 73ok(!exists $e->{sets_plan}, "Removed sets_plan key"); 74ok(!$e->sets_plan, "sets_plan is cleared"); 75 76$e->set_global(0); 77is($e->global, 0, "global is off"); 78$e->set_global(1); 79is($e->global, 1, "global is on"); 80$e->set_global(0); 81is($e->global, 0, "global is again"); 82$e->set_global(undef); 83ok(!exists $e->{global}, "removed global key"); 84is($e->global, undef, "global is not defined"); 85 86like( 87 exception { $e->set_callback('dogfood') }, 88 qr/callback must be a code reference/, 89 "Callback must be code" 90); 91 92my $ran = 0; 93$e->set_callback(sub { 94 $ran++; 95 my $self = shift; 96 is($self, $e, "got self"); 97 is_deeply( \@_, ['a', 'b', 'c'], "Got args" ); 98 return 'foo'; 99}); 100is($e->callback('a', 'b', 'c'), 'foo', "got callback's return"); 101ok($ran, "ran callback"); 102 103$e->set_callback(undef); 104ok(!$e->callback, "no callback"); 105ok(!exists $e->{callback}, "no callback key"); 106 107like( 108 exception { $e->set_terminate('1.1') }, 109 qr/terminate must be a positive integer/, 110 "terminate only takes integers" 111); 112 113like( 114 exception { $e->set_terminate('foo') }, 115 qr/terminate must be a positive integer/, 116 "terminate only takes numbers" 117); 118 119like( 120 exception { $e->set_terminate('-1') }, 121 qr/terminate must be a positive integer/, 122 "terminate only takes positive integers" 123); 124 125$e->set_terminate(0), 126is($e->terminate, 0, "set to 0, 0 is valid"); 127$e->set_terminate(1), 128is($e->terminate, 1, "set to 1"); 129$e->set_terminate(123), 130is($e->terminate, 123, "set to 123"); 131$e->set_terminate(0), 132is($e->terminate, 0, "set to 0, 0 is valid"); 133 134$e->set_terminate(undef); 135is($e->terminate, undef, "terminate is not defined"); 136ok(!exists $e->{terminate}, "no terminate key"); 137 138# Test constructor args 139intercept { $e = tool(causes_fail => 1, increments_count => 'a') }; 140is($e->causes_fail, 1, "attr from constructor"); 141is($e->increments_count, 'a', "attr from constructor"); 142 143done_testing; 144