File Coverage

blib/lib/Test2/API/Stack.pm
Criterion Covered Total %
statement 55 55 100.0
branch 18 20 90.0
condition 8 11 72.7
subroutine 15 15 100.0
pod 7 8 87.5
total 103 109 94.5


line stmt bran cond sub pod time code
1             package Test2::API::Stack;
2 246     246   1692 use strict;
  246         469  
  246         7376  
3 246     246   1217 use warnings;
  246         436  
  246         9571  
4              
5             our $VERSION = '1.302180';
6              
7              
8 246     246   114612 use Test2::Hub();
  246         613  
  246         6706  
9              
10 246     246   1844 use Carp qw/confess/;
  246         492  
  246         103846  
11              
12             sub new {
13 403     403 1 933 my $class = shift;
14 403         1583 return bless [], $class;
15             }
16              
17             sub new_hub {
18 601     601 1 1344 my $self = shift;
19 601         1886 my %params = @_;
20              
21 601   100     3398 my $class = delete $params{class} || 'Test2::Hub';
22              
23 601         4409 my $hub = $class->new(%params);
24              
25 601 100       2161 if (@$self) {
26 290         1188 $hub->inherit($self->[-1], %params);
27             }
28             else {
29 311         2100 require Test2::API;
30             $hub->format(Test2::API::test2_formatter()->new_root)
31 311 50 66     1705 unless $hub->format || exists($params{formatter});
32              
33 311         1378 my $ipc = Test2::API::test2_ipc();
34 311 50 66     1936 if ($ipc && !$hub->ipc && !exists($params{ipc})) {
      66        
35 45         320 $hub->set_ipc($ipc);
36 45         206 $ipc->add_hub($hub->hid);
37             }
38             }
39              
40 601         1748 push @$self => $hub;
41              
42 601         2541 $hub;
43             }
44              
45             sub top {
46 2420     2420 1 5830 my $self = shift;
47 2420 100       6083 return $self->new_hub unless @$self;
48 2156         5012 return $self->[-1];
49             }
50              
51             sub peek {
52 2     2 1 5 my $self = shift;
53 2 100       13 return @$self ? $self->[-1] : undef;
54             }
55              
56             sub cull {
57 1     1 1 5 my $self = shift;
58 1         5 $_->cull for reverse @$self;
59             }
60              
61             sub all {
62 253     253 1 1110 my $self = shift;
63 253         1403 return @$self;
64             }
65              
66             sub root {
67 247     247 0 791 my $self = shift;
68 247 100       1238 return unless @$self;
69 246         1539 return $self->[0];
70             }
71              
72             sub clear {
73 2     2 1 8 my $self = shift;
74 2         6 @$self = ();
75             }
76              
77             # Do these last without keywords in order to prevent them from getting used
78             # when we want the real push/pop.
79              
80             {
81 246     246   2111 no warnings 'once';
  246         546  
  246         51027  
82              
83             *push = sub {
84 66     66   149 my $self = shift;
85 66         166 my ($hub) = @_;
86 66 100       400 $hub->inherit($self->[-1]) if @$self;
87 66         186 push @$self => $hub;
88             };
89              
90             *pop = sub {
91 339     339   674 my $self = shift;
92 339         683 my ($hub) = @_;
93 339 100       1154 confess "No hubs on the stack"
94             unless @$self;
95 338 100       1041 confess "You cannot pop the root hub"
96             if 1 == @$self;
97 337 100       1156 confess "Hub stack mismatch, attempted to pop incorrect hub"
98             unless $self->[-1] == $hub;
99 336         829 pop @$self;
100             };
101             }
102              
103             1;
104              
105             __END__