← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/Util/Facets2Legacy.pm
StatementsExecuted 15 statements in 608µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111940µs1.00msTest2::Util::Facets2Legacy::::BEGIN@10Test2::Util::Facets2Legacy::BEGIN@10
1119µs11µsTest2::Util::Facets2Legacy::::BEGIN@2Test2::Util::Facets2Legacy::BEGIN@2
1114µs19µsTest2::Util::Facets2Legacy::::BEGIN@3Test2::Util::Facets2Legacy::BEGIN@3
1114µs22µsTest2::Util::Facets2Legacy::::BEGIN@7Test2::Util::Facets2Legacy::BEGIN@7
1113µs15µsTest2::Util::Facets2Legacy::::BEGIN@8Test2::Util::Facets2Legacy::BEGIN@8
0000s0sTest2::Util::Facets2Legacy::::_get_facet_dataTest2::Util::Facets2Legacy::_get_facet_data
0000s0sTest2::Util::Facets2Legacy::::causes_failTest2::Util::Facets2Legacy::causes_fail
0000s0sTest2::Util::Facets2Legacy::::diagnosticsTest2::Util::Facets2Legacy::diagnostics
0000s0sTest2::Util::Facets2Legacy::::globalTest2::Util::Facets2Legacy::global
0000s0sTest2::Util::Facets2Legacy::::increments_countTest2::Util::Facets2Legacy::increments_count
0000s0sTest2::Util::Facets2Legacy::::no_displayTest2::Util::Facets2Legacy::no_display
0000s0sTest2::Util::Facets2Legacy::::sets_planTest2::Util::Facets2Legacy::sets_plan
0000s0sTest2::Util::Facets2Legacy::::subtest_idTest2::Util::Facets2Legacy::subtest_id
0000s0sTest2::Util::Facets2Legacy::::summaryTest2::Util::Facets2Legacy::summary
0000s0sTest2::Util::Facets2Legacy::::terminateTest2::Util::Facets2Legacy::terminate
0000s0sTest2::Util::Facets2Legacy::::uuidTest2::Util::Facets2Legacy::uuid
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test2::Util::Facets2Legacy;
2220µs212µs
# spent 11µs (9+1) within Test2::Util::Facets2Legacy::BEGIN@2 which was called: # once (9µs+1µs) by Test2::Event::V2::BEGIN@12 at line 2
use strict;
# spent 11µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@2 # spent 2µs making 1 call to strict::import
3223µs235µs
# spent 19µs (4+16) within Test2::Util::Facets2Legacy::BEGIN@3 which was called: # once (4µs+16µs) by Test2::Event::V2::BEGIN@12 at line 3
use warnings;
# spent 19µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@3 # spent 16µs making 1 call to warnings::import
4
51300nsour $VERSION = '1.302198';
6
7219µs240µs
# spent 22µs (4+18) within Test2::Util::Facets2Legacy::BEGIN@7 which was called: # once (4µs+18µs) by Test2::Event::V2::BEGIN@12 at line 7
use Carp qw/croak confess/;
# spent 22µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@7 # spent 18µs making 1 call to Exporter::import
8214µs226µs
# spent 15µs (3+12) within Test2::Util::Facets2Legacy::BEGIN@8 which was called: # once (3µs+12µs) by Test2::Event::V2::BEGIN@12 at line 8
use Scalar::Util qw/blessed/;
# spent 15µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@8 # spent 12µs making 1 call to Exporter::import
9
102526µs21.04ms
# spent 1.00ms (940µs+61µs) within Test2::Util::Facets2Legacy::BEGIN@10 which was called: # once (940µs+61µs) by Test2::Event::V2::BEGIN@12 at line 10
use base 'Exporter';
# spent 1.00ms making 1 call to Test2::Util::Facets2Legacy::BEGIN@10 # spent 41µs making 1 call to base::import
1111µsour @EXPORT_OK = qw{
12 causes_fail
13 diagnostics
14 global
15 increments_count
16 no_display
17 sets_plan
18 subtest_id
19 summary
20 terminate
21 uuid
22};
2311µsour %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
24
251100nsour $CYCLE_DETECT = 0;
26sub _get_facet_data {
27 my $in = shift;
28
29 if (blessed($in) && $in->isa('Test2::Event')) {
30 confess "Cycle between Facets2Legacy and $in\->facet_data() (Did you forget to override the facet_data() method?)"
31 if $CYCLE_DETECT;
32
33 local $CYCLE_DETECT = 1;
34 return $in->facet_data;
35 }
36
37 return $in if ref($in) eq 'HASH';
38
39 croak "'$in' Does not appear to be either a Test::Event or an EventFacet hashref";
40}
41
42sub causes_fail {
43 my $facet_data = _get_facet_data(shift @_);
44
45 return 1 if $facet_data->{errors} && grep { $_->{fail} } @{$facet_data->{errors}};
46
47 if (my $control = $facet_data->{control}) {
48 return 1 if $control->{halt};
49 return 1 if $control->{terminate};
50 }
51
52 return 0 if $facet_data->{amnesty} && @{$facet_data->{amnesty}};
53 return 1 if $facet_data->{assert} && !$facet_data->{assert}->{pass};
54 return 0;
55}
56
57sub diagnostics {
58 my $facet_data = _get_facet_data(shift @_);
59 return 1 if $facet_data->{errors} && @{$facet_data->{errors}};
60 return 0 unless $facet_data->{info} && @{$facet_data->{info}};
61 return (grep { $_->{debug} } @{$facet_data->{info}}) ? 1 : 0;
62}
63
64sub global {
65 my $facet_data = _get_facet_data(shift @_);
66 return 0 unless $facet_data->{control};
67 return $facet_data->{control}->{global};
68}
69
70sub increments_count {
71 my $facet_data = _get_facet_data(shift @_);
72 return $facet_data->{assert} ? 1 : 0;
73}
74
75sub no_display {
76 my $facet_data = _get_facet_data(shift @_);
77 return 0 unless $facet_data->{about};
78 return $facet_data->{about}->{no_display};
79}
80
81sub sets_plan {
82 my $facet_data = _get_facet_data(shift @_);
83 my $plan = $facet_data->{plan} or return;
84 my @out = ($plan->{count} || 0);
85
86 if ($plan->{skip}) {
87 push @out => 'SKIP';
88 push @out => $plan->{details} if defined $plan->{details};
89 }
90 elsif ($plan->{none}) {
91 push @out => 'NO PLAN'
92 }
93
94 return @out;
95}
96
97sub subtest_id {
98 my $facet_data = _get_facet_data(shift @_);
99 return undef unless $facet_data->{parent};
100 return $facet_data->{parent}->{hid};
101}
102
103sub summary {
104 my $facet_data = _get_facet_data(shift @_);
105 return '' unless $facet_data->{about} && $facet_data->{about}->{details};
106 return $facet_data->{about}->{details};
107}
108
109sub terminate {
110 my $facet_data = _get_facet_data(shift @_);
111 return undef unless $facet_data->{control};
112 return $facet_data->{control}->{terminate};
113}
114
115sub uuid {
116 my $in = shift;
117
118 if ($CYCLE_DETECT) {
119 if (blessed($in) && $in->isa('Test2::Event')) {
120 my $meth = $in->can('uuid');
121 $meth = $in->can('SUPER::uuid') if $meth == \&uuid;
122 my $uuid = $in->$meth if $meth && $meth != \&uuid;
123 return $uuid if $uuid;
124 }
125
126 return undef;
127 }
128
129 my $facet_data = _get_facet_data($in);
130 return $facet_data->{about}->{uuid} if $facet_data->{about} && $facet_data->{about}->{uuid};
131
132 return undef;
133}
134
13513µs1;
136
137=pod
138
139=encoding UTF-8
140
141=head1 NAME
142
143Test2::Util::Facets2Legacy - Convert facet data to the legacy event API.
144
145=head1 DESCRIPTION
146
147This module exports several subroutines from the older event API (see
148L<Test2::Event>). These subroutines can be used as methods on any object that
149provides a custom C<facet_data()> method. These subroutines can also be used as
150functions that take a facet data hashref as arguments.
151
152=head1 SYNOPSIS
153
154=head2 AS METHODS
155
156 package My::Event;
157
158 use Test2::Util::Facets2Legacy ':ALL';
159
160 sub facet_data { return { ... } }
161
162Then to use it:
163
164 my $e = My::Event->new(...);
165
166 my $causes_fail = $e->causes_fail;
167 my $summary = $e->summary;
168 ....
169
170=head2 AS FUNCTIONS
171
172 use Test2::Util::Facets2Legacy ':ALL';
173
174 my $f = {
175 assert => { ... },
176 info => [{...}, ...],
177 control => {...},
178 ...
179 };
180
181 my $causes_fail = causes_fail($f);
182 my $summary = summary($f);
183
184=head1 NOTE ON CYCLES
185
186When used as methods, all these subroutines call C<< $e->facet_data() >>. The
187default C<facet_data()> method in L<Test2::Event> relies on the legacy methods
188this module emulates in order to work. As a result of this it is very easy to
189create infinite recursion bugs.
190
191These methods have cycle detection and will throw an exception early if a cycle
192is detected. C<uuid()> is currently the only subroutine in this library that
193has a fallback behavior when cycles are detected.
194
195=head1 EXPORTS
196
197Nothing is exported by default. You must specify which methods to import, or
198use the ':ALL' tag.
199
200=over 4
201
202=item $bool = $e->causes_fail()
203
204=item $bool = causes_fail($f)
205
206Check if the event or facets result in a failing state.
207
208=item $bool = $e->diagnostics()
209
210=item $bool = diagnostics($f)
211
212Check if the event or facets contain any diagnostics information.
213
214=item $bool = $e->global()
215
216=item $bool = global($f)
217
218Check if the event or facets need to be globally processed.
219
220=item $bool = $e->increments_count()
221
222=item $bool = increments_count($f)
223
224Check if the event or facets make an assertion.
225
226=item $bool = $e->no_display()
227
228=item $bool = no_display($f)
229
230Check if the event or facets should be rendered or hidden.
231
232=item ($max, $directive, $reason) = $e->sets_plan()
233
234=item ($max, $directive, $reason) = sets_plan($f)
235
236Check if the event or facets set a plan, and return the plan details.
237
238=item $id = $e->subtest_id()
239
240=item $id = subtest_id($f)
241
242Get the subtest id, if any.
243
244=item $string = $e->summary()
245
246=item $string = summary($f)
247
248Get the summary of the event or facets hash, if any.
249
250=item $undef_or_int = $e->terminate()
251
252=item $undef_or_int = terminate($f)
253
254Check if the event or facets should result in process termination, if so the
255exit code is returned (which could be 0). undef is returned if no termination
256is requested.
257
258=item $uuid = $e->uuid()
259
260=item $uuid = uuid($f)
261
262Get the UUID of the facets or event.
263
264B<Note:> This will fall back to C<< $e->SUPER::uuid() >> if a cycle is
265detected and an event is used as the argument.
266
267=back
268
269=head1 SOURCE
270
271The source code repository for Test2 can be found at
272F<http://github.com/Test-More/test-more/>.
273
274=head1 MAINTAINERS
275
276=over 4
277
278=item Chad Granum E<lt>exodist@cpan.orgE<gt>
279
280=back
281
282=head1 AUTHORS
283
284=over 4
285
286=item Chad Granum E<lt>exodist@cpan.orgE<gt>
287
288=back
289
290=head1 COPYRIGHT
291
292Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
293
294This program is free software; you can redistribute it and/or
295modify it under the same terms as Perl itself.
296
297See F<http://dev.perl.org/licenses/>
298
299=cut