1package Test2::API::InterceptResult; 2use strict; 3use warnings; 4 5our $VERSION = '1.302183'; 6 7use Scalar::Util qw/blessed/; 8use Test2::Util qw/pkg_to_file/; 9use Storable qw/dclone/; 10use Carp qw/croak/; 11 12use Test2::API::InterceptResult::Squasher; 13use Test2::API::InterceptResult::Event; 14use Test2::API::InterceptResult::Hub; 15 16sub new { 17 croak "Called a method that creates a new instance in void context" unless defined wantarray; 18 my $class = shift; 19 bless([@_], $class); 20} 21 22sub new_from_ref { 23 croak "Called a method that creates a new instance in void context" unless defined wantarray; 24 bless($_[1], $_[0]); 25} 26 27sub clone { blessed($_[0])->new(@{dclone($_[0])}) } 28 29sub event_list { @{$_[0]} } 30 31sub _upgrade { 32 my $self = shift; 33 my ($event, %params) = @_; 34 35 my $blessed = blessed($event); 36 37 my $upgrade_class = $params{upgrade_class} ||= 'Test2::API::InterceptResult::Event'; 38 39 return $event if $blessed && $event->isa($upgrade_class) && !$params{_upgrade_clone}; 40 41 my $fd = dclone($blessed ? $event->facet_data : $event); 42 43 my $class = $params{result_class} ||= blessed($self); 44 45 if (my $parent = $fd->{parent}) { 46 $parent->{children} = $class->new_from_ref($parent->{children} || [])->upgrade(%params); 47 } 48 49 my $uc_file = pkg_to_file($upgrade_class); 50 require($uc_file) unless $INC{$uc_file}; 51 return $upgrade_class->new(facet_data => $fd, result_class => $class); 52} 53 54sub hub { 55 my $self = shift; 56 57 my $hub = Test2::API::InterceptResult::Hub->new(); 58 $hub->process($_) for @$self; 59 $hub->set_ended(1); 60 61 return $hub; 62} 63 64sub state { 65 my $self = shift; 66 my %params = @_; 67 68 my $hub = $self->hub; 69 70 my $out = { 71 map {($_ => scalar $hub->$_)} qw/count failed is_passing plan bailed_out skip_reason/ 72 }; 73 74 $out->{bailed_out} = $self->_upgrade($out->{bailed_out}, %params)->bailout_reason || 1 75 if $out->{bailed_out}; 76 77 $out->{follows_plan} = $hub->check_plan; 78 79 return $out; 80} 81 82sub upgrade { 83 my $self = shift; 84 my %params = @_; 85 86 my @out = map { $self->_upgrade($_, %params, _upgrade_clone => 1) } @$self; 87 88 return blessed($self)->new_from_ref(\@out) 89 unless $params{in_place}; 90 91 @$self = @out; 92 return $self; 93} 94 95sub squash_info { 96 my $self = shift; 97 my %params = @_; 98 99 my @out; 100 101 { 102 my $squasher = Test2::API::InterceptResult::Squasher->new(events => \@out); 103 # Clone to make sure we do not indirectly modify an existing one if it 104 # is already upgraded 105 $squasher->process($self->_upgrade($_, %params)->clone) for @$self; 106 $squasher->flush_down(); 107 } 108 109 return blessed($self)->new_from_ref(\@out) 110 unless $params{in_place}; 111 112 @$self = @out; 113 return $self; 114} 115 116sub asserts { shift->grep(has_assert => @_) } 117sub subtests { shift->grep(has_subtest => @_) } 118sub diags { shift->grep(has_diags => @_) } 119sub notes { shift->grep(has_notes => @_) } 120sub errors { shift->grep(has_errors => @_) } 121sub plans { shift->grep(has_plan => @_) } 122sub causes_fail { shift->grep(causes_fail => @_) } 123sub causes_failure { shift->grep(causes_failure => @_) } 124 125sub flatten { shift->map(flatten => @_) } 126sub briefs { shift->map(brief => @_) } 127sub summaries { shift->map(summary => @_) } 128sub subtest_results { shift->map(subtest_result => @_) } 129sub diag_messages { shift->map(diag_messages => @_) } 130sub note_messages { shift->map(note_messages => @_) } 131sub error_messages { shift->map(error_messages => @_) } 132 133no warnings 'once'; 134 135*map = sub { 136 my $self = shift; 137 my ($call, %params) = @_; 138 139 my $args = $params{args} ||= []; 140 141 return [map { local $_ = $self->_upgrade($_, %params); $_->$call(@$args) } @$self]; 142}; 143 144*grep = sub { 145 my $self = shift; 146 my ($call, %params) = @_; 147 148 my $args = $params{args} ||= []; 149 150 my @out = grep { local $_ = $self->_upgrade($_, %params); $_->$call(@$args) } @$self; 151 152 return blessed($self)->new_from_ref(\@out) 153 unless $params{in_place}; 154 155 @$self = @out; 156 return $self; 157}; 158 1591; 160 161__END__ 162 163=pod 164 165=encoding UTF-8 166 167=head1 NAME 168 169Test2::API::InterceptResult - Representation of a list of events. 170 171=head1 DESCRIPTION 172 173This class represents a list of events, normally obtained using C<intercept()> 174from L<Test2::API>. 175 176This class is intended for people who with to verify the results of test tools 177they write. 178 179This class provides methods to normalize, summarize, or map the list of events. 180The output of these operations makes verifying your testing tools and the 181events they generate significantly easier. In most cases this spares you from 182needing a deep understanding of the event/facet model. 183 184=head1 SYNOPSIS 185 186Usually you get an instance of this class when you use C<intercept()> from 187L<Test2::API>. 188 189 use Test2::V0; 190 use Test2::API qw/intercept/; 191 192 my $events = intercept { 193 ok(1, "pass"); 194 ok(0, "fail"); 195 todo "broken" => sub { ok(0, "fixme") }; 196 plan 3; 197 }; 198 199 # This is typically the most useful construct 200 # squash_info() merges assertions and diagnostics that are associated 201 # (and returns a new instance with the modifications) 202 # flatten() condenses the facet data into the key details for each event 203 # (and returns those structures in an arrayref) 204 is( 205 $events->squash_info->flatten(), 206 [ 207 { 208 causes_failure => 0, 209 210 name => 'pass', 211 pass => 1, 212 213 trace_file => 'xxx.t', 214 trace_line => 5, 215 }, 216 { 217 causes_failure => 1, 218 219 name => 'fail', 220 pass => 0, 221 222 trace_file => 'xxx.t', 223 trace_line => 6, 224 225 # There can be more than one diagnostics message so this is 226 # always an array when present. 227 diag => ["Failed test 'fail'\nat xxx.t line 6."], 228 }, 229 { 230 causes_failure => 0, 231 232 name => 'fixme', 233 pass => 0, 234 235 trace_file => 'xxx.t', 236 trace_line => 7, 237 238 # There can be more than one diagnostics message or todo 239 # reason, so these are always an array when present. 240 todo => ['broken'], 241 242 # Diag message was turned into a note since the assertion was 243 # TODO 244 note => ["Failed test 'fixme'\nat xxx.t line 7."], 245 }, 246 { 247 causes_failure => 0, 248 249 plan => 3, 250 251 trace_file => 'xxx.t', 252 trace_line => 8, 253 }, 254 ], 255 "Flattened events look like we expect" 256 ); 257 258See L<Test2::API::InterceptResult::Event> for a full description of what 259C<flatten()> provides for each event. 260 261=head1 METHODS 262 263Please note that no methods modify the original instance unless asked to do so. 264 265=head2 CONSTRUCTION 266 267=over 4 268 269=item $events = Test2::API::InterceptResult->new(@EVENTS) 270 271=item $events = Test2::API::InterceptResult->new_from_ref(\@EVENTS) 272 273These create a new instance of Test2::API::InterceptResult from the given 274events. 275 276In the first form a new blessed arrayref is returned. In the 'new_from_ref' 277form the reference you pass in is directly blessed. 278 279Both of these will throw an exception if called in void context. This is mainly 280important for the 'filtering' methods listed below which normally return a new 281instance, they throw an exception in such cases as it probably means someone 282meant to filter the original in place. 283 284=item $clone = $events->clone() 285 286Make a clone of the original events. Note that this is a deep copy, the entire 287structure is duplicated. This uses C<dclone> from L<Storable> to achieve the 288deep clone. 289 290=back 291 292=head2 NORMALIZATION 293 294=over 4 295 296=item @events = $events->event_list 297 298This returns all the events in list-form. 299 300=item $hub = $events->hub 301 302This returns a new L<Test2::Hub> instance that has processed all the events 303contained in the instance. This gives you a simple way to inspect the state 304changes your events cause. 305 306=item $state = $events->state 307 308This returns a summary of the state of a hub after processing all the events. 309 310 { 311 count => 2, # Number of assertions made 312 failed => 1, # Number of test failures seen 313 is_passing => 0, # Boolean, true if the test would be passing 314 # after the events are processed. 315 316 plan => 2, # Plan, either a number, undef, 'SKIP', or 'NO PLAN' 317 follows_plan => 1, # True if there is a plan and it was followed. 318 # False if the plan and assertions did not 319 # match, undef if no plan was present in the 320 # event list. 321 322 bailed_out => undef, # undef unless there was a bail-out in the 323 # events in which case this will be a string 324 # explaining why there was a bailout, if no 325 # reason was given this will simply be set to 326 # true (1). 327 328 skip_reason => undef, # If there was a skip_all this will give the 329 # reason. 330 } 331 332 333=item $new = $events->upgrade 334 335=item $events->upgrade(in_place => $BOOL) 336 337B<Note:> This normally returns a new instance, leaving the original unchanged. 338If you call it in void context it will throw an exception. If you want to 339modify the original you must pass in the C<< in_place => 1 >> option. You may 340call this in void context when you ask to modify it in place. The in-place form 341returns the instance that was modified so you can chain methods. 342 343This will create a clone of the list where all events have been converted into 344L<Test2::API::InterceptResult::Event> instances. This is extremely helpful as 345L<Test2::API::InterceptResult::Event> provide a much better interface for 346working with events. This allows you to avoid thinking about legacy event 347types. 348 349This also means your tests against the list are not fragile if the tool 350you are testing randomly changes what type of events it generates (IE Changing 351from L<Test2::Event::Ok> to L<Test2::Event::Pass>, both make assertions and 352both will normalize to identical (or close enough) 353L<Test2::API::InterceptResult::Event> instances. 354 355Really you almost always want this, the only reason it is not done 356automatically is to make sure the C<intercept()> tool is backwards compatible. 357 358=item $new = $events->squash_info 359 360=item $events->squash_info(in_place => $BOOL) 361 362B<Note:> This normally returns a new instance, leaving the original unchanged. 363If you call it in void context it will throw an exception. If you want to 364modify the original you must pass in the C<< in_place => 1 >> option. You may 365call this in void context when you ask to modify it in place. The in-place form 366returns the instance that was modified so you can chain methods. 367 368B<Note:> All events in the new or modified instance will be converted to 369L<Test2::API::InterceptResult::Event> instances. There is no way to avoid this, 370the squash operation requires the upgraded event class. 371 372L<Test::More> and many other legacy tools would send notes, diags, and 373assertions as seperate events. A subtest in L<Test::More> would send a note 374with the subtest name, the subtest assertion, and finally a diagnostics event 375if the subtest failed. This method will normalize things by squashing the note 376and diag into the same event as the subtest (This is different from putting 377them into the subtest, which is not what happens). 378 379=back 380 381=head2 FILTERING 382 383B<Note:> These normally return new instances, leaving the originals unchanged. 384If you call them in void context they will throw exceptions. If you want to 385modify the originals you must pass in the C<< in_place => 1 >> option. You may 386call these in void context when you ask to modify them in place. The in-place 387forms return the instance that was modified so you can chain methods. 388 389=head3 %PARAMS 390 391These all accept the same 2 optional parameters: 392 393=over 4 394 395=item in_place => $BOOL 396 397When true the method will modify the instance in place instead of returning a 398new instance. 399 400=item args => \@ARGS 401 402If you wish to pass parameters into the event method being used for filtering, 403you may do so here. 404 405=back 406 407=head3 METHODS 408 409=over 4 410 411=item $events->grep($CALL, %PARAMS) 412 413This is essentially: 414 415 Test2::API::InterceptResult->new( 416 grep { $_->$CALL( @{$PARAMS{args}} ) } $self->event_list, 417 ); 418 419B<Note:> that $CALL is called on an upgraded version of the event, though 420the events returned will be the original ones, not the upgraded ones. 421 422$CALL may be either the name of a method on 423L<Test2::API::InterceptResult::Event>, or a coderef. 424 425=item $events->asserts(%PARAMS) 426 427This is essentially: 428 429 $events->grep(has_assert => @{$PARAMS{args}}) 430 431It returns a new instance containing only the events that made assertions. 432 433=item $events->subtests(%PARAMS) 434 435This is essentially: 436 437 $events->grep(has_subtest => @{$PARAMS{args}}) 438 439It returns a new instance containing only the events that have subtests. 440 441=item $events->diags(%PARAMS) 442 443This is essentially: 444 445 $events->grep(has_diags => @{$PARAMS{args}}) 446 447It returns a new instance containing only the events that have diags. 448 449=item $events->notes(%PARAMS) 450 451This is essentially: 452 453 $events->grep(has_notes => @{$PARAMS{args}}) 454 455It returns a new instance containing only the events that have notes. 456 457=item $events->errors(%PARAMS) 458 459B<Note:> Errors are NOT failing assertions. Failing assertions are a different 460thing. 461 462This is essentially: 463 464 $events->grep(has_errors => @{$PARAMS{args}}) 465 466It returns a new instance containing only the events that have errors. 467 468=item $events->plans(%PARAMS) 469 470This is essentially: 471 472 $events->grep(has_plan => @{$PARAMS{args}}) 473 474It returns a new instance containing only the events that set the plan. 475 476=item $events->causes_fail(%PARAMS) 477 478=item $events->causes_failure(%PARAMS) 479 480These are essentially: 481 482 $events->grep(causes_fail => @{$PARAMS{args}}) 483 $events->grep(causes_failure => @{$PARAMS{args}}) 484 485B<Note:> C<causes_fail()> and C<causes_failure()> are both aliases for 486eachother in events, so these methods are effectively aliases here as well. 487 488It returns a new instance containing only the events that cause failure. 489 490=back 491 492=head2 MAPPING 493 494These methods B<ALWAYS> return an arrayref. 495 496B<Note:> No methods on L<Test2::API::InterceptResult::Event> alter the event in 497any way. 498 499B<Important Notes about Events>: 500 501L<Test2::API::InterceptResult::Event> was tailor-made to be used in 502event-lists. Most methods that are not applicable to a given event will return 503an empty list, so you normally do not need to worry about unwanted C<undef> 504values or exceptions being thrown. Mapping over event methods is an entended 505use, so it works well to produce lists. 506 507B<Exceptions to the rule:> 508 509Some methods such as C<causes_fail> always return a boolean true or false for 510all events. Any method prefixed with C<the_> conveys the intent that the event 511should have exactly 1 of something, so those will throw an exception when that 512condition is not true. 513 514=over 4 515 516=item $arrayref = $events->map($CALL, %PARAMS) 517 518This is essentially: 519 520 [ map { $_->$CALL(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 521 522$CALL may be either the name of a method on 523L<Test2::API::InterceptResult::Event>, or a coderef. 524 525=item $arrayref = $events->flatten(%PARAMS) 526 527This is essentially: 528 529 [ map { $_->flatten(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 530 531It returns a new list of flattened structures. 532 533See L<Test2::API::InterceptResult::Event> for details on what C<flatten()> 534returns. 535 536=item $arrayref = $events->briefs(%PARAMS) 537 538This is essentially: 539 540 [ map { $_->briefs(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 541 542It returns a new list of event briefs. 543 544See L<Test2::API::InterceptResult::Event> for details on what C<brief()> 545returns. 546 547=item $arrayref = $events->summaries(%PARAMS) 548 549This is essentially: 550 551 [ map { $_->summaries(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 552 553It returns a new list of event summaries. 554 555See L<Test2::API::InterceptResult::Event> for details on what C<summary()> 556returns. 557 558=item $arrayref = $events->subtest_results(%PARAMS) 559 560This is essentially: 561 562 [ map { $_->subtest_result(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 563 564It returns a new list of event summaries. 565 566See L<Test2::API::InterceptResult::Event> for details on what 567C<subtest_result()> returns. 568 569=item $arrayref = $events->diag_messages(%PARAMS) 570 571This is essentially: 572 573 [ map { $_->diag_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 574 575It returns a new list of diagnostic messages (strings). 576 577See L<Test2::API::InterceptResult::Event> for details on what 578C<diag_messages()> returns. 579 580=item $arrayref = $events->note_messages(%PARAMS) 581 582This is essentially: 583 584 [ map { $_->note_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 585 586It returns a new list of notification messages (strings). 587 588See L<Test2::API::InterceptResult::Event> for details on what 589C<note_messages()> returns. 590 591=item $arrayref = $events->error_messages(%PARAMS) 592 593This is essentially: 594 595 [ map { $_->error_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ]; 596 597It returns a new list of error messages (strings). 598 599See L<Test2::API::InterceptResult::Event> for details on what 600C<error_messages()> returns. 601 602=back 603 604=head1 SOURCE 605 606The source code repository for Test2 can be found at 607F<http://github.com/Test-More/test-more/>. 608 609=head1 MAINTAINERS 610 611=over 4 612 613=item Chad Granum E<lt>exodist@cpan.orgE<gt> 614 615=back 616 617=head1 AUTHORS 618 619=over 4 620 621=item Chad Granum E<lt>exodist@cpan.orgE<gt> 622 623=back 624 625=head1 COPYRIGHT 626 627Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. 628 629This program is free software; you can redistribute it and/or 630modify it under the same terms as Perl itself. 631 632See F<http://dev.perl.org/licenses/> 633 634=cut 635