Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/Util/Facets2Legacy.pm |
Statements | Executed 15 statements in 608µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 940µs | 1.00ms | BEGIN@10 | Test2::Util::Facets2Legacy::
1 | 1 | 1 | 9µs | 11µs | BEGIN@2 | Test2::Util::Facets2Legacy::
1 | 1 | 1 | 4µs | 19µs | BEGIN@3 | Test2::Util::Facets2Legacy::
1 | 1 | 1 | 4µs | 22µs | BEGIN@7 | Test2::Util::Facets2Legacy::
1 | 1 | 1 | 3µs | 15µs | BEGIN@8 | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | _get_facet_data | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | causes_fail | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | diagnostics | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | global | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | increments_count | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | no_display | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | sets_plan | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | subtest_id | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | summary | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | terminate | Test2::Util::Facets2Legacy::
0 | 0 | 0 | 0s | 0s | uuid | Test2::Util::Facets2Legacy::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Test2::Util::Facets2Legacy; | ||||
2 | 2 | 20µs | 2 | 12µ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 # spent 11µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@2
# spent 2µs making 1 call to strict::import |
3 | 2 | 23µs | 2 | 35µ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 # spent 19µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@3
# spent 16µs making 1 call to warnings::import |
4 | |||||
5 | 1 | 300ns | our $VERSION = '1.302198'; | ||
6 | |||||
7 | 2 | 19µs | 2 | 40µ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 # spent 22µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@7
# spent 18µs making 1 call to Exporter::import |
8 | 2 | 14µs | 2 | 26µ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 # spent 15µs making 1 call to Test2::Util::Facets2Legacy::BEGIN@8
# spent 12µs making 1 call to Exporter::import |
9 | |||||
10 | 2 | 526µs | 2 | 1.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 # spent 1.00ms making 1 call to Test2::Util::Facets2Legacy::BEGIN@10
# spent 41µs making 1 call to base::import |
11 | 1 | 1µs | our @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 | }; | ||||
23 | 1 | 1µs | our %EXPORT_TAGS = ( ALL => \@EXPORT_OK ); | ||
24 | |||||
25 | 1 | 100ns | our $CYCLE_DETECT = 0; | ||
26 | sub _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 | |||||
42 | sub 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 | |||||
57 | sub 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 | |||||
64 | sub global { | ||||
65 | my $facet_data = _get_facet_data(shift @_); | ||||
66 | return 0 unless $facet_data->{control}; | ||||
67 | return $facet_data->{control}->{global}; | ||||
68 | } | ||||
69 | |||||
70 | sub increments_count { | ||||
71 | my $facet_data = _get_facet_data(shift @_); | ||||
72 | return $facet_data->{assert} ? 1 : 0; | ||||
73 | } | ||||
74 | |||||
75 | sub 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 | |||||
81 | sub 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 | |||||
97 | sub 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 | |||||
103 | sub 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 | |||||
109 | sub terminate { | ||||
110 | my $facet_data = _get_facet_data(shift @_); | ||||
111 | return undef unless $facet_data->{control}; | ||||
112 | return $facet_data->{control}->{terminate}; | ||||
113 | } | ||||
114 | |||||
115 | sub 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 | |||||
135 | 1 | 3µs | 1; | ||
136 | |||||
137 | =pod | ||||
138 | |||||
139 | =encoding UTF-8 | ||||
140 | |||||
141 | =head1 NAME | ||||
142 | |||||
143 | Test2::Util::Facets2Legacy - Convert facet data to the legacy event API. | ||||
144 | |||||
145 | =head1 DESCRIPTION | ||||
146 | |||||
147 | This module exports several subroutines from the older event API (see | ||||
148 | L<Test2::Event>). These subroutines can be used as methods on any object that | ||||
149 | provides a custom C<facet_data()> method. These subroutines can also be used as | ||||
150 | functions 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 | |||||
162 | Then 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 | |||||
186 | When used as methods, all these subroutines call C<< $e->facet_data() >>. The | ||||
187 | default C<facet_data()> method in L<Test2::Event> relies on the legacy methods | ||||
188 | this module emulates in order to work. As a result of this it is very easy to | ||||
189 | create infinite recursion bugs. | ||||
190 | |||||
191 | These methods have cycle detection and will throw an exception early if a cycle | ||||
192 | is detected. C<uuid()> is currently the only subroutine in this library that | ||||
193 | has a fallback behavior when cycles are detected. | ||||
194 | |||||
195 | =head1 EXPORTS | ||||
196 | |||||
197 | Nothing is exported by default. You must specify which methods to import, or | ||||
198 | use the ':ALL' tag. | ||||
199 | |||||
200 | =over 4 | ||||
201 | |||||
202 | =item $bool = $e->causes_fail() | ||||
203 | |||||
204 | =item $bool = causes_fail($f) | ||||
205 | |||||
206 | Check if the event or facets result in a failing state. | ||||
207 | |||||
208 | =item $bool = $e->diagnostics() | ||||
209 | |||||
210 | =item $bool = diagnostics($f) | ||||
211 | |||||
212 | Check if the event or facets contain any diagnostics information. | ||||
213 | |||||
214 | =item $bool = $e->global() | ||||
215 | |||||
216 | =item $bool = global($f) | ||||
217 | |||||
218 | Check 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 | |||||
224 | Check if the event or facets make an assertion. | ||||
225 | |||||
226 | =item $bool = $e->no_display() | ||||
227 | |||||
228 | =item $bool = no_display($f) | ||||
229 | |||||
230 | Check 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 | |||||
236 | Check 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 | |||||
242 | Get the subtest id, if any. | ||||
243 | |||||
244 | =item $string = $e->summary() | ||||
245 | |||||
246 | =item $string = summary($f) | ||||
247 | |||||
248 | Get 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 | |||||
254 | Check if the event or facets should result in process termination, if so the | ||||
255 | exit code is returned (which could be 0). undef is returned if no termination | ||||
256 | is requested. | ||||
257 | |||||
258 | =item $uuid = $e->uuid() | ||||
259 | |||||
260 | =item $uuid = uuid($f) | ||||
261 | |||||
262 | Get the UUID of the facets or event. | ||||
263 | |||||
264 | B<Note:> This will fall back to C<< $e->SUPER::uuid() >> if a cycle is | ||||
265 | detected and an event is used as the argument. | ||||
266 | |||||
267 | =back | ||||
268 | |||||
269 | =head1 SOURCE | ||||
270 | |||||
271 | The source code repository for Test2 can be found at | ||||
272 | F<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 | |||||
292 | Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. | ||||
293 | |||||
294 | This program is free software; you can redistribute it and/or | ||||
295 | modify it under the same terms as Perl itself. | ||||
296 | |||||
297 | See F<http://dev.perl.org/licenses/> | ||||
298 | |||||
299 | =cut |