File Coverage

blib/lib/Test2/Harness/Parser/TAP/SubtestState.pm
Criterion Covered Total %
statement 48 51 94.1
branch 12 16 75.0
condition 6 7 85.7
subroutine 8 8 100.0
pod 0 4 0.0
total 74 86 86.0


line stmt bran cond sub pod time code
1             package Test2::Harness::Parser::TAP::SubtestState;
2 24     24   74 use strict;
  24         66  
  24         506  
3 24     24   109 use warnings;
  24         68  
  24         817  
4              
5             our $VERSION = '0.000013';
6              
7 24     24   73 use Carp qw/confess/;
  24         24  
  24         1646  
8 24     24   95 use Test2::Util::HashBase qw/_subtest_id _last_id _state/;
  24         45  
  24         100  
9              
10             sub init {
11 275     275 0 4588 my $self = shift;
12 275         1968 $self->{+_SUBTEST_ID} = 'A';
13 275         710 $self->{+_LAST_ID} = '';
14 275         985 $self->{+_STATE} = [];
15             }
16              
17             sub maybe_start_streaming_subtest {
18 1301     1301 0 6822 my $self = shift;
19 1301         1420 my ($e) = @_;
20              
21 1301   100     2590 my $nest = $e->nested || 0;
22 1301 100       11353 return $e unless $nest > 0;
23              
24 50         47 my $id;
25              
26 50 50       71 if ($e->in_subtest) {
27 0         0 confess(
28             sprintf(
29             'Got a %s object already in a subtest (ID = %s) that might start a streaming subtest',
30             ref $e,
31             $e->in_subtest
32             )
33             );
34             }
35              
36             # We will see a Test2::Event::Subtest event object when we finish a
37             # streaming subtest. We don't want that event to trigger the start of a
38             # new streaming subtest. Instead, that subtest needs to be added to
39             # subevents of a parent subtest, if one exists.
40 50 100 66     299 if ($e->isa('Test2::Event::Subtest') && $e->subtest_id eq $self->{+_LAST_ID}) {
41 12 50       89 return $e unless $nest > 0;
42 12         25 $nest--;
43             # The subtest itself is at the nesting level of its parent (another
44             # subtest or the main test).
45 12         46 $e->set_nested($nest);
46 12 100       90 return $e unless $self->{+_STATE}[$nest];
47             }
48              
49 42 100       78 if ($self->{+_STATE}[$nest]) {
50 30         42 $id = $self->{+_STATE}[$nest]{id};
51             }
52             else {
53 12         27 $id = $self->next_id;
54 12         38 $self->{+_STATE}[$nest] = {
55             id => $id,
56             subevents => [],
57             };
58             }
59              
60 42         39 push @{$self->{+_STATE}[$nest]{subevents}}, $e;
  42         75  
61              
62 42         90 $e->set_in_subtest($id);
63              
64 42         291 return $e;
65             }
66              
67             sub finish_streaming_subtest {
68 12     12 0 25 my $self = shift;
69 12         24 my ($pass, $name, $nest) = @_;
70              
71             # The ok event that ends a streaming subtest is one nesting level lower
72             # than the events that make up the subtest.
73 12   100     58 $nest = ($nest || 0) + 1;
74 12 50       30 unless ($self->{+_STATE}[$nest]) {
75 0         0 confess "Cannot find any subtest state at nesting level $nest to finish!";
76             }
77              
78 12         16 my $max = $#{$self->{+_STATE}};
  12         22  
79 12 50       29 if ($max > $nest) {
80 0         0 confess "Ending a subtest at nesting level $nest but there are still subtests in-process up to level $max!";
81             }
82              
83 12         8 my $state = pop @{$self->{+_STATE}};
  12         18  
84 12         20 $self->{+_LAST_ID} = $state->{id};
85              
86             return (
87             pass => $pass,
88             name => $name,
89             nested => $nest,
90             subtest_id => $state->{id},
91             subevents => $state->{subevents},
92 12         70 );
93             }
94              
95             sub next_id {
96 698     698 0 697 my $self = shift;
97 698         1859 return $self->{+_SUBTEST_ID}++;
98             }
99              
100             1;
101              
102             __END__