| 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 | Test2::Util::Facets2Legacy::BEGIN@10 |
| 1 | 1 | 1 | 9µs | 11µs | Test2::Util::Facets2Legacy::BEGIN@2 |
| 1 | 1 | 1 | 4µs | 19µs | Test2::Util::Facets2Legacy::BEGIN@3 |
| 1 | 1 | 1 | 4µs | 22µs | Test2::Util::Facets2Legacy::BEGIN@7 |
| 1 | 1 | 1 | 3µs | 15µs | Test2::Util::Facets2Legacy::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::_get_facet_data |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::causes_fail |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::diagnostics |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::global |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::increments_count |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::no_display |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::sets_plan |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::subtest_id |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::summary |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::terminate |
| 0 | 0 | 0 | 0s | 0s | Test2::Util::Facets2Legacy::uuid |
| 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 |