1use strict; 2use warnings; 3 4use Test::Builder; 5use Test2::Tools::Tiny; 6use Test2::API::InterceptResult; 7use Scalar::Util qw/reftype/; 8use Test2::API qw/intercept context/; 9 10my $CLASS = 'Test2::API::InterceptResult'; 11 12tests construction => sub { 13 my $one = $CLASS->new('a'); 14 ok($one->isa($CLASS), "Got an instance"); 15 is(reftype($one), 'ARRAY', "Blessed arrayref"); 16 is_deeply($one, ['a'], "Ref looks good."); 17 18 my $two = $CLASS->new_from_ref(['a']); 19 ok($two->isa($CLASS), "Got an instance"); 20 is(reftype($two), 'ARRAY', "Blessed arrayref"); 21 is_deeply($two, ['a'], "Ref looks good."); 22 23 my $three = $two->clone; 24 ok($three->isa($CLASS), "Got an instance"); 25 is(reftype($three), 'ARRAY', "Blessed arrayref"); 26 is_deeply($three, ['a'], "Ref looks good."); 27 28 push @$two => 'b'; 29 is_deeply($two, ['a', 'b'], "Modified two"); 30 is_deeply($three, ['a'], "three was not changed"); 31 32 my $four = intercept { 33 ok(1, "Pass"); 34 }; 35 36 ok($four->isa($CLASS), "Intercept returns an instance"); 37}; 38 39tests event_list => sub { 40 my $one = $CLASS->new('a', 'b'); 41 is_deeply([$one->event_list], ['a', 'b'], "event_list is essentially \@{\$self}"); 42}; 43 44tests _upgrade => sub { 45 require Test2::Event::Pass; 46 my $event = Test2::Event::Pass->new(name => 'soup for you', trace => {frame => ['foo', 'foo.pl', 42]}); 47 ok($event->isa('Test2::Event'), "Start with an event"); 48 49 my $one = $CLASS->new; 50 my $up = $one->_upgrade($event); 51 ok($up->isa('Test2::API::InterceptResult::Event'), "Upgraded the event"); 52 is($up->result_class, $CLASS, "set the result class"); 53 54 is_deeply($event->facet_data, $up->facet_data, "Facet data is identical"); 55 56 $up->facet_data->{trace}->{frame}->[2] = 43; 57 is($up->trace_line, 43, "Modified the facet data in the upgraded clone"); 58 is($event->facet_data->{trace}->{frame}->[2], 42, "Did not modify the original"); 59 60 my $up2 = $one->_upgrade($up); 61 is("$up2", "$up", "Returned the ref unmodified because it is already an upgraded item"); 62 63 require Test2::Event::V2; 64 my $subtest = 'Test2::Event::V2'->new( 65 trace => {frame => ['foo', 'foo.pl', 42]}, 66 assert => {pass => 1, details => 'pass'}, 67 parent => { 68 hid => 1, 69 children => [ $event ], 70 }, 71 ); 72 73 my $subup = $one->_upgrade($subtest); 74 ok($subup->the_subtest->{children}->isa($CLASS), "Blessed subtest subevents"); 75 ok( 76 $subup->the_subtest->{children}->[0]->isa('Test2::API::InterceptResult::Event'), 77 "Upgraded the children" 78 ); 79}; 80 81tests hub => sub { 82 my $one = intercept { 83 ok(1, "pass"); 84 ok(0, "fail"); 85 plan 2; 86 }; 87 88 my $hub = $one->hub; 89 ok($hub->isa('Test2::Hub'), "Hub is a proper instance"); 90 ok($hub->check_plan, "Had a plan and followed it"); 91 is($hub->count, 2, "saw both events"); 92 is($hub->failed, 1, "saw a failure"); 93 ok($hub->ended, "Hub ended"); 94 95 is_deeply( 96 $one->state, 97 { 98 count => 2, 99 failed => 1, 100 is_passing => 0, 101 plan => 2, 102 bailed_out => undef, 103 skip_reason => undef, 104 follows_plan => 1, 105 }, 106 "Got the hub state" 107 ); 108}; 109 110tests upgrade => sub { 111 my $one = intercept { 112 require Test::More; 113 Test::More::ok(1, "pass"); 114 Test::More::ok(1, "pass"); 115 }; 116 117 ok($one->[0]->isa('Test2::Event::Ok'), "Original event is not upgraded 0"); 118 ok($one->[1]->isa('Test2::Event::Ok'), "Original event is not upgraded 1"); 119 120 my $two = $one->upgrade; 121 ok($one->[0]->isa('Test2::Event::Ok'), "Did not modify original 0"); 122 ok($one->[0]->isa('Test2::Event::Ok'), "Did not modify original 1"); 123 ok($two->[0]->isa('Test2::API::InterceptResult::Event'), "Upgraded copy 0"); 124 ok($two->[1]->isa('Test2::API::InterceptResult::Event'), "Upgraded copy 1"); 125 126 my $three = $two->upgrade; 127 ok("$two->[0]" ne "$three->[0]", "Upgrade on an already upgraded instance returns copies of the events, not originals"); 128 129 like( 130 exception { $one->upgrade() }, 131 qr/Called a method that creates a new instance in void context/, 132 "Calling upgrade() without keeping the result is a bug" 133 ); 134 135 $one->upgrade(in_place => 1); 136 ok($one->[0]->isa('Test2::API::InterceptResult::Event'), "Upgraded in place 0"); 137 ok($one->[1]->isa('Test2::API::InterceptResult::Event'), "Upgraded in place 1"); 138}; 139 140tests squash_info => sub { 141 my $one = intercept { 142 diag "isolated 1"; 143 note "isolated 2"; 144 sub { 145 my $ctx = context(); 146 diag "inline 1"; 147 note "inline 2"; 148 $ctx->fail; 149 diag "inline 3"; 150 note "inline 4"; 151 $ctx->release; 152 }->(); 153 diag "isolated 3"; 154 note "isolated 4"; 155 }; 156 157 my $new = $one->squash_info; 158 $one->squash_info(in_place => 1); 159 is_deeply( 160 $new, 161 $one, 162 "Squash and squash in place produce the same result" 163 ); 164 165 is(@$one, 5, "5 events after squash"); 166 is_deeply([$one->[0]->info_messages], ['isolated 1'], "First event not modified"); 167 is_deeply([$one->[1]->info_messages], ['isolated 2'], "Second event not modified"); 168 is_deeply([$one->[3]->info_messages], ['isolated 3'], "second to last event not modified"); 169 is_deeply([$one->[4]->info_messages], ['isolated 4'], "last event not modified"); 170 is_deeply( 171 [$one->[2]->info_messages], 172 [ 173 'inline 1', 174 'inline 2', 175 'inline 3', 176 'inline 4', 177 ], 178 "Assertion collected info generated in the same context" 179 ); 180 ok($one->[2]->has_assert, "Assertion is still an assertion"); 181 182 183 my $two = intercept { 184 185 }; 186}; 187 188tests messages => sub { 189 my $one = intercept { 190 note "foo"; 191 diag "bar"; 192 193 ok(1); 194 195 sub { 196 my $ctx = context(); 197 198 $ctx->send_ev2( 199 errors => [ 200 {tag => 'error', details => "Error 1" }, 201 {tag => 'error', details => "Error 2" }, 202 ], 203 info => [ 204 {tag => 'DIAG', details => 'Diag 1'}, 205 {tag => 'DIAG', details => 'Diag 2'}, 206 {tag => 'NOTE', details => 'Note 1'}, 207 {tag => 'NOTE', details => 'Note 2'}, 208 ], 209 ); 210 211 $ctx->release; 212 }->(); 213 214 note "baz"; 215 diag "bat"; 216 }; 217 218 is_deeply( 219 $one->diag_messages, 220 ['bar', 'Diag 1', 'Diag 2', 'bat'], 221 "Got diags" 222 ); 223 224 is_deeply( 225 $one->note_messages, 226 ['foo', 'Note 1', 'Note 2', 'baz'], 227 "Got Notes" 228 ); 229 230 is_deeply( 231 $one->error_messages, 232 ['Error 1', 'Error 2'], 233 "Got errors" 234 ); 235}; 236 237tests grep => sub { 238 my $one = intercept { 239 ok(1), # 0 240 note "A Note"; # 1 241 diag "A Diag"; # 2 242 tests foo => sub { ok(1) }; # 3 243 244 sub { # 4 245 my $ctx = context(); 246 $ctx->send_ev2(errors => [{tag => 'error', details => "Error 1"}]); 247 $ctx->release; 248 }->(); # 4 249 250 plan 2; # 5 251 }; 252 253 $one->upgrade(in_place => 1); 254 255 is_deeply($one->asserts, [$one->[0], $one->[3]], "Got the asserts"); 256 is_deeply($one->subtests, [$one->[3]], "Got the subtests"); 257 is_deeply($one->diags, [$one->[2]], "Got the diags"); 258 is_deeply($one->notes, [$one->[1]], "Got the notes"); 259 is_deeply($one->errors, [$one->[4]], "Got the errors"); 260 is_deeply($one->plans, [$one->[5]], "Got the plans"); 261 262 $one->asserts(in_place => 1); 263 is(@$one, 2, "2 events"); 264 ok($_->has_assert, "Is an assert") for @$one; 265}; 266 267tests map => sub { 268 my $one = intercept { ok(1); ok(2) }; 269 $one->upgrade(in_place => 1); 270 271 is_deeply( 272 $one->flatten, 273 [ $one->[0]->flatten, $one->[1]->flatten ], 274 "Flattened both events" 275 ); 276 277 is_deeply( 278 $one->briefs, 279 [ $one->[0]->brief, $one->[1]->brief ], 280 "Brief of both events" 281 ); 282 283 is_deeply( 284 $one->summaries, 285 [ $one->[0]->summary, $one->[1]->summary ], 286 "Summaries of both events" 287 ); 288 289 my $two = intercept { 290 tests foo => sub { ok(1) }; 291 ok(1); 292 tests bar => sub { ok(1) }; 293 }->upgrade; 294 295 is_deeply( 296 $two->subtest_results, 297 [ $two->[0]->subtest_result, $two->[2]->subtest_result ], 298 "Got subtest results" 299 ); 300}; 301 302done_testing; 303