| Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm |
| Statements | Executed 283 statements in 6.59ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 5.39ms | 27.5ms | Test::Builder::BEGIN@18 |
| 1 | 1 | 1 | 1.33ms | 11.2ms | Test::Builder::BEGIN@17 |
| 1 | 1 | 1 | 1.17ms | 1.48ms | Test::Builder::BEGIN@15 |
| 1 | 1 | 1 | 343µs | 2.62ms | Test::Builder::BEGIN@36 |
| 1 | 1 | 1 | 164µs | 202µs | Test::Builder::BEGIN@37 |
| 1 | 1 | 1 | 47µs | 430µs | Test::Builder::reset |
| 1 | 1 | 1 | 45µs | 353µs | Test::Builder::done_testing |
| 1 | 1 | 1 | 40µs | 256µs | Test::Builder::ok |
| 1 | 1 | 1 | 29µs | 43µs | Test::Builder::_ending |
| 1 | 1 | 1 | 28µs | 59µs | Test::Builder::reset_outputs |
| 8 | 8 | 1 | 20µs | 419µs | Test::Builder::ctx |
| 5 | 2 | 2 | 16µs | 53µs | Test::Builder::new |
| 1 | 1 | 1 | 16µs | 48µs | Test::Builder::use_numbers |
| 1 | 1 | 1 | 15µs | 58µs | Test::Builder::__ANON__[:156] |
| 3 | 1 | 1 | 14µs | 14µs | Test::Builder::__ANON__[:88] |
| 1 | 1 | 1 | 14µs | 14µs | Test::Builder::BEGIN@3 |
| 1 | 1 | 1 | 12µs | 12µs | Test::Builder::BEGIN@1232 |
| 1 | 1 | 1 | 11µs | 29µs | Test::Builder::expected_tests |
| 1 | 1 | 1 | 11µs | 40µs | Test::Builder::current_test |
| 1 | 1 | 1 | 8µs | 9µs | Test::Builder::BEGIN@33 |
| 1 | 1 | 1 | 8µs | 13µs | Test::Builder::_add_ts_hooks |
| 1 | 1 | 1 | 7µs | 13µs | Test::Builder::create |
| 1 | 1 | 1 | 7µs | 19µs | Test::Builder::BEGIN@1519 |
| 8 | 1 | 1 | 7µs | 7µs | Test::Builder::__ANON__[:154] |
| 1 | 1 | 1 | 6µs | 11µs | Test::Builder::BEGIN@1518 |
| 1 | 1 | 1 | 6µs | 10µs | Test::Builder::BEGIN@1251 |
| 1 | 1 | 1 | 6µs | 449µs | Test::Builder::__ANON__[:148] |
| 1 | 1 | 1 | 6µs | 6µs | Test::Builder::BEGIN@34 |
| 1 | 1 | 1 | 6µs | 9µs | Test::Builder::BEGIN@1556 |
| 1 | 1 | 1 | 5µs | 21µs | Test::Builder::BEGIN@684 |
| 1 | 1 | 1 | 5µs | 19µs | Test::Builder::BEGIN@1057 |
| 1 | 1 | 1 | 5µs | 9µs | Test::Builder::BEGIN@1539 |
| 1 | 1 | 1 | 5µs | 18µs | Test::Builder::BEGIN@797 |
| 1 | 1 | 1 | 5µs | 9µs | Test::Builder::BEGIN@102 |
| 1 | 1 | 1 | 5µs | 18µs | Test::Builder::BEGIN@1167 |
| 1 | 1 | 1 | 5µs | 8µs | Test::Builder::BEGIN@116 |
| 1 | 1 | 1 | 5µs | 12µs | Test::Builder::BEGIN@20 |
| 1 | 1 | 1 | 5µs | 9µs | Test::Builder::BEGIN@61 |
| 1 | 1 | 1 | 4µs | 19µs | Test::Builder::BEGIN@120 |
| 1 | 1 | 1 | 4µs | 14µs | Test::Builder::BEGIN@131 |
| 1 | 1 | 1 | 4µs | 26µs | Test::Builder::BEGIN@693 |
| 1 | 1 | 1 | 4µs | 5µs | Test::Builder::BEGIN@4 |
| 1 | 1 | 1 | 4µs | 15µs | Test::Builder::INIT |
| 1 | 1 | 1 | 4µs | 14µs | Test::Builder::BEGIN@103 |
| 1 | 1 | 1 | 4µs | 14µs | Test::Builder::BEGIN@1540 |
| 1 | 1 | 1 | 4µs | 15µs | Test::Builder::BEGIN@62 |
| 1 | 1 | 1 | 3µs | 13µs | Test::Builder::BEGIN@1557 |
| 1 | 1 | 1 | 3µs | 17µs | Test::Builder::BEGIN@133 |
| 1 | 1 | 1 | 3µs | 23µs | Test::Builder::BEGIN@5 |
| 1 | 1 | 1 | 3µs | 12µs | Test::Builder::BEGIN@117 |
| 1 | 1 | 1 | 3µs | 10µs | Test::Builder::BEGIN@121 |
| 2 | 2 | 2 | 2µs | 2µs | Test::Builder::exported_to |
| 1 | 1 | 1 | 2µs | 2µs | Test::Builder::BEGIN@9 |
| 3 | 3 | 1 | 1µs | 1µs | Test::Builder::__ANON__ (xsub) |
| 1 | 1 | 1 | 1µs | 1µs | Test::Builder::plan |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::BAIL_OUT |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:111] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:1249] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:125] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:1591] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:245] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:247] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::__ANON__[:764] |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_autoflush |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_caller_context |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_cmp_diag |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_diag_fh |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_diag_fmt |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_is_diag |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_is_dualvar |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_is_qr |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_isnt_diag |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_new_fh |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_ok_debug |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_plan_tests |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_print_comment |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_regex_ok |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_try |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_unoverload |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_unoverload_num |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::_unoverload_str |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::caller |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::carp |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::child |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::cmp_ok |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::coordinate_forks |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::croak |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::details |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::diag |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::explain |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::failure_output |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::finalize |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::find_TODO |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::has_plan |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::in_todo |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::is_eq |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::is_fh |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::is_num |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::is_passing |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::isnt_eq |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::isnt_num |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::level |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::like |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::maybe_regex |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::name |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::no_ending |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::no_log_results |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::no_plan |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::note |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::output |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::parent |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::skip |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::skip_all |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::subtest |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::summary |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::todo |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::todo_end |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::todo_output |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::todo_skip |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::todo_start |
| 0 | 0 | 0 | 0s | 0s | Test::Builder::unlike |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Test::Builder; | ||||
| 2 | |||||
| 3 | 2 | 31µs | 1 | 14µs | # spent 14µs within Test::Builder::BEGIN@3 which was called:
# once (14µs+0s) by Test::Builder::Module::BEGIN@5 at line 3 # spent 14µs making 1 call to Test::Builder::BEGIN@3 |
| 4 | 2 | 13µs | 2 | 7µs | # spent 5µs (4+2) within Test::Builder::BEGIN@4 which was called:
# once (4µs+2µs) by Test::Builder::Module::BEGIN@5 at line 4 # spent 5µs making 1 call to Test::Builder::BEGIN@4
# spent 2µs making 1 call to strict::import |
| 5 | 2 | 36µs | 2 | 42µs | # spent 23µs (3+20) within Test::Builder::BEGIN@5 which was called:
# once (3µs+20µs) by Test::Builder::Module::BEGIN@5 at line 5 # spent 23µs making 1 call to Test::Builder::BEGIN@5
# spent 20µs making 1 call to warnings::import |
| 6 | |||||
| 7 | 1 | 400ns | our $VERSION = '1.302198'; | ||
| 8 | |||||
| 9 | # spent 2µs within Test::Builder::BEGIN@9 which was called:
# once (2µs+0s) by Test::Builder::Module::BEGIN@5 at line 13 | ||||
| 10 | 1 | 2µs | if( $] < 5.008 ) { | ||
| 11 | require Test::Builder::IO::Scalar; | ||||
| 12 | } | ||||
| 13 | 1 | 19µs | 1 | 2µs | } # spent 2µs making 1 call to Test::Builder::BEGIN@9 |
| 14 | |||||
| 15 | 2 | 101µs | 2 | 1.52ms | # spent 1.48ms (1.17+307µs) within Test::Builder::BEGIN@15 which was called:
# once (1.17ms+307µs) by Test::Builder::Module::BEGIN@5 at line 15 # spent 1.48ms making 1 call to Test::Builder::BEGIN@15
# spent 41µs making 1 call to Exporter::import |
| 16 | |||||
| 17 | 2 | 88µs | 2 | 11.2ms | # spent 11.2ms (1.33+9.87) within Test::Builder::BEGIN@17 which was called:
# once (1.33ms+9.87ms) by Test::Builder::Module::BEGIN@5 at line 17 # spent 11.2ms making 1 call to Test::Builder::BEGIN@17
# spent 39µs making 1 call to Exporter::import |
| 18 | 2 | 112µs | 2 | 27.6ms | # spent 27.5ms (5.39+22.1) within Test::Builder::BEGIN@18 which was called:
# once (5.39ms+22.1ms) by Test::Builder::Module::BEGIN@5 at line 18 # spent 27.5ms making 1 call to Test::Builder::BEGIN@18
# spent 79µs making 1 call to Exporter::import |
| 19 | # Make Test::Builder thread-safe for ithreads. | ||||
| 20 | # spent 12µs (5+7) within Test::Builder::BEGIN@20 which was called:
# once (5µs+7µs) by Test::Builder::Module::BEGIN@5 at line 31 | ||||
| 21 | 1 | 1µs | 2 | 7µs | warn "Test::Builder was loaded after Test2 initialization, this is not recommended." # spent 5µs making 1 call to Test2::API::test2_init_done
# spent 2µs making 1 call to Test2::API::test2_load_done |
| 22 | if Test2::API::test2_init_done() || Test2::API::test2_load_done(); | ||||
| 23 | |||||
| 24 | 1 | 1µs | if (USE_THREADS && ! Test2::API::test2_ipc_disabled()) { | ||
| 25 | require Test2::IPC; | ||||
| 26 | require Test2::IPC::Driver::Files; | ||||
| 27 | Test2::IPC::Driver::Files->import; | ||||
| 28 | Test2::API::test2_ipc_enable_polling(); | ||||
| 29 | Test2::API::test2_no_wait(1); | ||||
| 30 | } | ||||
| 31 | 1 | 13µs | 1 | 12µs | } # spent 12µs making 1 call to Test::Builder::BEGIN@20 |
| 32 | |||||
| 33 | 2 | 18µs | 2 | 9µs | # spent 9µs (8+300ns) within Test::Builder::BEGIN@33 which was called:
# once (8µs+300ns) by Test::Builder::Module::BEGIN@5 at line 33 # spent 9µs making 1 call to Test::Builder::BEGIN@33
# spent 300ns making 1 call to Test::Builder::__ANON__ |
| 34 | 2 | 15µs | 2 | 6µs | # spent 6µs (6+200ns) within Test::Builder::BEGIN@34 which was called:
# once (6µs+200ns) by Test::Builder::Module::BEGIN@5 at line 34 # spent 6µs making 1 call to Test::Builder::BEGIN@34
# spent 200ns making 1 call to Test::Builder::__ANON__ |
| 35 | |||||
| 36 | 2 | 72µs | 2 | 2.63ms | # spent 2.62ms (343µs+2.28) within Test::Builder::BEGIN@36 which was called:
# once (343µs+2.28ms) by Test::Builder::Module::BEGIN@5 at line 36 # spent 2.62ms making 1 call to Test::Builder::BEGIN@36
# spent 12µs making 1 call to Test2::Formatter::import |
| 37 | 2 | 133µs | 2 | 203µs | # spent 202µs (164+39) within Test::Builder::BEGIN@37 which was called:
# once (164µs+39µs) by Test::Builder::Module::BEGIN@5 at line 37 # spent 202µs making 1 call to Test::Builder::BEGIN@37
# spent 700ns making 1 call to Test::Builder::__ANON__ |
| 38 | |||||
| 39 | 1 | 200ns | our $Level = 1; | ||
| 40 | 1 | 3µs | 1 | 48µs | our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new; # spent 48µs making 1 call to Test::Builder::new |
| 41 | |||||
| 42 | # spent 13µs (8+5) within Test::Builder::_add_ts_hooks which was called:
# once (8µs+5µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] at line 147 | ||||
| 43 | 1 | 200ns | my $self = shift; | ||
| 44 | |||||
| 45 | 1 | 800ns | 1 | 900ns | my $hub = $self->{Stack}->top; # spent 900ns making 1 call to Test2::API::Stack::top |
| 46 | |||||
| 47 | # Take a reference to the hash key, we do this to avoid closing over $self | ||||
| 48 | # which is the singleton. We use a reference because the value could change | ||||
| 49 | # in rare cases. | ||||
| 50 | 1 | 400ns | my $epkgr = \$self->{Exported_To}; | ||
| 51 | |||||
| 52 | #$hub->add_context_aquire(sub {$_[0]->{level} += $Level - 1}); | ||||
| 53 | |||||
| 54 | $hub->pre_filter( | ||||
| 55 | # spent 14µs within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:88] which was called 3 times, avg 5µs/call:
# 3 times (14µs+0s) by Test2::Hub::send at line 301 of Test2/Hub.pm, avg 5µs/call | ||||
| 56 | 3 | 800ns | my ($active_hub, $e) = @_; | ||
| 57 | |||||
| 58 | 3 | 800ns | my $epkg = $$epkgr; | ||
| 59 | 3 | 2µs | my $cpkg = $e->{trace} ? $e->{trace}->{frame}->[0] : undef; | ||
| 60 | |||||
| 61 | 2 | 20µs | 2 | 12µs | # spent 9µs (5+4) within Test::Builder::BEGIN@61 which was called:
# once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 61 # spent 9µs making 1 call to Test::Builder::BEGIN@61
# spent 4µs making 1 call to strict::unimport |
| 62 | 2 | 130µs | 2 | 26µs | # spent 15µs (4+11) within Test::Builder::BEGIN@62 which was called:
# once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 62 # spent 15µs making 1 call to Test::Builder::BEGIN@62
# spent 11µs making 1 call to warnings::unimport |
| 63 | 3 | 300ns | my $todo; | ||
| 64 | 3 | 4µs | $todo = ${"$cpkg\::TODO"} if $cpkg; | ||
| 65 | 3 | 2µs | $todo = ${"$epkg\::TODO"} if $epkg && !$todo; | ||
| 66 | |||||
| 67 | 3 | 4µs | return $e unless defined($todo); | ||
| 68 | return $e unless length($todo); | ||||
| 69 | |||||
| 70 | # Turn a diag into a todo diag | ||||
| 71 | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag'; | ||||
| 72 | |||||
| 73 | $e->set_todo($todo) if $e->can('set_todo'); | ||||
| 74 | $e->add_amnesty({tag => 'TODO', details => $todo}); | ||||
| 75 | |||||
| 76 | # Set todo on ok's | ||||
| 77 | if ($e->isa('Test2::Event::Ok')) { | ||||
| 78 | $e->set_effective_pass(1); | ||||
| 79 | |||||
| 80 | if (my $result = $e->get_meta(__PACKAGE__)) { | ||||
| 81 | $result->{reason} ||= $todo; | ||||
| 82 | $result->{type} ||= 'todo'; | ||||
| 83 | $result->{ok} = 1; | ||||
| 84 | } | ||||
| 85 | } | ||||
| 86 | |||||
| 87 | return $e; | ||||
| 88 | }, | ||||
| 89 | |||||
| 90 | inherit => 1, | ||||
| 91 | |||||
| 92 | intercept_inherit => { | ||||
| 93 | clean => sub { | ||||
| 94 | my %params = @_; | ||||
| 95 | |||||
| 96 | my $state = $params{state}; | ||||
| 97 | my $trace = $params{trace}; | ||||
| 98 | |||||
| 99 | my $epkg = $$epkgr; | ||||
| 100 | my $cpkg = $trace->{frame}->[0]; | ||||
| 101 | |||||
| 102 | 2 | 20µs | 2 | 12µs | # spent 9µs (5+4) within Test::Builder::BEGIN@102 which was called:
# once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 102 # spent 9µs making 1 call to Test::Builder::BEGIN@102
# spent 4µs making 1 call to strict::unimport |
| 103 | 2 | 81µs | 2 | 25µs | # spent 14µs (4+11) within Test::Builder::BEGIN@103 which was called:
# once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 103 # spent 14µs making 1 call to Test::Builder::BEGIN@103
# spent 11µs making 1 call to warnings::unimport |
| 104 | |||||
| 105 | $state->{+__PACKAGE__} = {}; | ||||
| 106 | $state->{+__PACKAGE__}->{"$cpkg\::TODO"} = ${"$cpkg\::TODO"} if $cpkg; | ||||
| 107 | $state->{+__PACKAGE__}->{"$epkg\::TODO"} = ${"$epkg\::TODO"} if $epkg; | ||||
| 108 | |||||
| 109 | ${"$cpkg\::TODO"} = undef if $cpkg; | ||||
| 110 | ${"$epkg\::TODO"} = undef if $epkg; | ||||
| 111 | }, | ||||
| 112 | restore => sub { | ||||
| 113 | my %params = @_; | ||||
| 114 | my $state = $params{state}; | ||||
| 115 | |||||
| 116 | 2 | 19µs | 2 | 12µs | # spent 8µs (5+4) within Test::Builder::BEGIN@116 which was called:
# once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 116 # spent 8µs making 1 call to Test::Builder::BEGIN@116
# spent 4µs making 1 call to strict::unimport |
| 117 | 2 | 27µs | 2 | 22µs | # spent 12µs (3+10) within Test::Builder::BEGIN@117 which was called:
# once (3µs+10µs) by Test::Builder::Module::BEGIN@5 at line 117 # spent 12µs making 1 call to Test::Builder::BEGIN@117
# spent 10µs making 1 call to warnings::unimport |
| 118 | |||||
| 119 | for my $item (keys %{$state->{+__PACKAGE__}}) { | ||||
| 120 | 2 | 29µs | 2 | 34µs | # spent 19µs (4+15) within Test::Builder::BEGIN@120 which was called:
# once (4µs+15µs) by Test::Builder::Module::BEGIN@5 at line 120 # spent 19µs making 1 call to Test::Builder::BEGIN@120
# spent 15µs making 1 call to strict::unimport |
| 121 | 2 | 61µs | 2 | 17µs | # spent 10µs (3+7) within Test::Builder::BEGIN@121 which was called:
# once (3µs+7µs) by Test::Builder::Module::BEGIN@5 at line 121 # spent 10µs making 1 call to Test::Builder::BEGIN@121
# spent 7µs making 1 call to warnings::unimport |
| 122 | |||||
| 123 | ${"$item"} = $state->{+__PACKAGE__}->{$item}; | ||||
| 124 | } | ||||
| 125 | }, | ||||
| 126 | }, | ||||
| 127 | 1 | 6µs | 1 | 4µs | ); # spent 4µs making 1 call to Test2::Hub::pre_filter |
| 128 | } | ||||
| 129 | |||||
| 130 | { | ||||
| 131 | 2 | 17µs | 2 | 25µs | # spent 14µs (4+10) within Test::Builder::BEGIN@131 which was called:
# once (4µs+10µs) by Test::Builder::Module::BEGIN@5 at line 131 # spent 14µs making 1 call to Test::Builder::BEGIN@131
# spent 10µs making 1 call to warnings::unimport |
| 132 | # spent 15µs (4+11) within Test::Builder::INIT which was called:
# once (4µs+11µs) by main::RUNTIME at line 0 of /home/micha/Projekt/spreadsheet-parsexlsx/t/bug-md-11.t | ||||
| 133 | 2 | 1.68ms | 2 | 31µs | # spent 17µs (3+14) within Test::Builder::BEGIN@133 which was called:
# once (3µs+14µs) by Test::Builder::Module::BEGIN@5 at line 133 # spent 17µs making 1 call to Test::Builder::BEGIN@133
# spent 14µs making 1 call to warnings::import |
| 134 | 1 | 4µs | 2 | 11µs | Test2::API::test2_load() unless Test2::API::test2_in_preload(); # spent 6µs making 1 call to Test2::API::test2_in_preload
# spent 5µs making 1 call to Test2::API::test2_load |
| 135 | } | ||||
| 136 | } | ||||
| 137 | |||||
| 138 | 1 | 200ns | # spent 53µs (16+36) within Test::Builder::new which was called 5 times, avg 11µs/call:
# 4 times (5µs+0s) by Test::Builder::Module::builder at line 172 of Test/Builder/Module.pm, avg 1µs/call
# once (12µs+36µs) by Test::Builder::Module::BEGIN@5 at line 40 | ||
| 139 | 5 | 1µs | my($class) = shift; | ||
| 140 | 5 | 2µs | unless($Test) { | ||
| 141 | 1 | 1µs | 1 | 13µs | $Test = $class->create(singleton => 1); # spent 13µs making 1 call to Test::Builder::create |
| 142 | |||||
| 143 | Test2::API::test2_add_callback_post_load( | ||||
| 144 | # spent 449µs (6+443) within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] which was called:
# once (6µs+443µs) by Test2::API::Instance::load at line 322 of Test2/API/Instance.pm | ||||
| 145 | 1 | 2µs | $Test->{Original_Pid} = $$ if !$Test->{Original_Pid} || $Test->{Original_Pid} == 0; | ||
| 146 | 1 | 1µs | 1 | 430µs | $Test->reset(singleton => 1); # spent 430µs making 1 call to Test::Builder::reset |
| 147 | 1 | 4µs | 1 | 13µs | $Test->_add_ts_hooks; # spent 13µs making 1 call to Test::Builder::_add_ts_hooks |
| 148 | } | ||||
| 149 | 1 | 2µs | 1 | 11µs | ); # spent 11µs making 1 call to Test2::API::test2_add_callback_post_load |
| 150 | |||||
| 151 | # Non-TB tools normally expect 0 added to the level. $Level is normally 1. So | ||||
| 152 | # we only want the level to change if $Level != 1. | ||||
| 153 | # TB->ctx compensates for this later. | ||||
| 154 | 9 | 12µs | 1 | 5µs | # spent 7µs within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:154] which was called 8 times, avg 862ns/call:
# 8 times (7µs+0s) by Test2::API::context at line 414 of Test2/API.pm, avg 862ns/call # spent 5µs making 1 call to Test2::API::test2_add_callback_context_aquire |
| 155 | |||||
| 156 | 2 | 5µs | 2 | 48µs | # spent 58µs (15+43) within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:156] which was called:
# once (15µs+43µs) by Test2::API::Instance::set_exit at line 554 of Test2/API/Instance.pm # spent 43µs making 1 call to Test::Builder::_ending
# spent 4µs making 1 call to Test2::API::test2_add_callback_exit |
| 157 | |||||
| 158 | 1 | 900ns | 1 | 3µs | Test2::API::test2_ipc()->set_no_fatal(1) if Test2::API::test2_has_ipc(); # spent 3µs making 1 call to Test2::API::test2_has_ipc |
| 159 | } | ||||
| 160 | 5 | 7µs | return $Test; | ||
| 161 | } | ||||
| 162 | |||||
| 163 | # spent 13µs (7+6) within Test::Builder::create which was called:
# once (7µs+6µs) by Test::Builder::new at line 141 | ||||
| 164 | 1 | 200ns | my $class = shift; | ||
| 165 | 1 | 700ns | my %params = @_; | ||
| 166 | |||||
| 167 | 1 | 600ns | my $self = bless {}, $class; | ||
| 168 | 1 | 3µs | 1 | 6µs | if ($params{singleton}) { # spent 6µs making 1 call to Test2::API::test2_stack |
| 169 | $self->{Stack} = Test2::API::test2_stack(); | ||||
| 170 | } | ||||
| 171 | else { | ||||
| 172 | $self->{Stack} = Test2::API::Stack->new; | ||||
| 173 | $self->{Stack}->new_hub( | ||||
| 174 | formatter => Test::Builder::Formatter->new, | ||||
| 175 | ipc => Test2::API::test2_ipc(), | ||||
| 176 | ); | ||||
| 177 | |||||
| 178 | $self->reset(%params); | ||||
| 179 | $self->_add_ts_hooks; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | 1 | 2µs | return $self; | ||
| 183 | } | ||||
| 184 | |||||
| 185 | # spent 419µs (20+400) within Test::Builder::ctx which was called 8 times, avg 52µs/call:
# once (3µs+213µs) by Test::Builder::reset at line 445
# once (4µs+61µs) by Test::Builder::ok at line 677
# once (2µs+30µs) by Test::Builder::reset at line 453
# once (2µs+27µs) by Test::Builder::done_testing at line 584
# once (2µs+21µs) by Test::Builder::use_numbers at line 1220
# once (2µs+19µs) by Test::Builder::current_test at line 1437
# once (2µs+16µs) by Test::Builder::reset_outputs at line 1409
# once (2µs+13µs) by Test::Builder::expected_tests at line 542 | ||||
| 186 | 8 | 1µs | my $self = shift; | ||
| 187 | context( | ||||
| 188 | # 1 for our frame, another for the -1 off of $Level in our hook at the top. | ||||
| 189 | level => 2, | ||||
| 190 | fudge => 1, | ||||
| 191 | stack => $self->{Stack}, | ||||
| 192 | hub => $self->{Hub}, | ||||
| 193 | 8 | 26µs | 8 | 400µs | wrapped => 1, # spent 400µs making 8 calls to Test2::API::context, avg 50µs/call |
| 194 | @_ | ||||
| 195 | ); | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | sub parent { | ||||
| 199 | my $self = shift; | ||||
| 200 | my $ctx = $self->ctx; | ||||
| 201 | my $chub = $self->{Hub} || $ctx->hub; | ||||
| 202 | $ctx->release; | ||||
| 203 | |||||
| 204 | my $meta = $chub->meta(__PACKAGE__, {}); | ||||
| 205 | my $parent = $meta->{parent}; | ||||
| 206 | |||||
| 207 | return undef unless $parent; | ||||
| 208 | |||||
| 209 | return bless { | ||||
| 210 | Original_Pid => $$, | ||||
| 211 | Stack => $self->{Stack}, | ||||
| 212 | Hub => $parent, | ||||
| 213 | }, blessed($self); | ||||
| 214 | } | ||||
| 215 | |||||
| 216 | sub child { | ||||
| 217 | my( $self, $name ) = @_; | ||||
| 218 | |||||
| 219 | $name ||= "Child of " . $self->name; | ||||
| 220 | my $ctx = $self->ctx; | ||||
| 221 | |||||
| 222 | my $parent = $ctx->hub; | ||||
| 223 | my $pmeta = $parent->meta(__PACKAGE__, {}); | ||||
| 224 | $self->croak("You already have a child named ($pmeta->{child}) running") | ||||
| 225 | if $pmeta->{child}; | ||||
| 226 | |||||
| 227 | $pmeta->{child} = $name; | ||||
| 228 | |||||
| 229 | # Clear $TODO for the child. | ||||
| 230 | my $orig_TODO = $self->find_TODO(undef, 1, undef); | ||||
| 231 | |||||
| 232 | my $subevents = []; | ||||
| 233 | |||||
| 234 | my $hub = $ctx->stack->new_hub( | ||||
| 235 | class => 'Test2::Hub::Subtest', | ||||
| 236 | ); | ||||
| 237 | |||||
| 238 | $hub->pre_filter(sub { | ||||
| 239 | my ($active_hub, $e) = @_; | ||||
| 240 | |||||
| 241 | # Turn a diag into a todo diag | ||||
| 242 | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag'; | ||||
| 243 | |||||
| 244 | return $e; | ||||
| 245 | }, inherit => 1) if $orig_TODO; | ||||
| 246 | |||||
| 247 | $hub->listen(sub { push @$subevents => $_[1] }); | ||||
| 248 | |||||
| 249 | $hub->set_nested( $parent->nested + 1 ); | ||||
| 250 | |||||
| 251 | my $meta = $hub->meta(__PACKAGE__, {}); | ||||
| 252 | $meta->{Name} = $name; | ||||
| 253 | $meta->{TODO} = $orig_TODO; | ||||
| 254 | $meta->{TODO_PKG} = $ctx->trace->package; | ||||
| 255 | $meta->{parent} = $parent; | ||||
| 256 | $meta->{Test_Results} = []; | ||||
| 257 | $meta->{subevents} = $subevents; | ||||
| 258 | $meta->{subtest_id} = $hub->id; | ||||
| 259 | $meta->{subtest_uuid} = $hub->uuid; | ||||
| 260 | $meta->{subtest_buffered} = $parent->format ? 0 : 1; | ||||
| 261 | |||||
| 262 | $self->_add_ts_hooks; | ||||
| 263 | |||||
| 264 | $ctx->release; | ||||
| 265 | return bless { Original_Pid => $$, Stack => $self->{Stack}, Hub => $hub, no_log_results => $self->{no_log_results} }, blessed($self); | ||||
| 266 | } | ||||
| 267 | |||||
| 268 | sub finalize { | ||||
| 269 | my $self = shift; | ||||
| 270 | my $ok = 1; | ||||
| 271 | ($ok) = @_ if @_; | ||||
| 272 | |||||
| 273 | my $st_ctx = $self->ctx; | ||||
| 274 | my $chub = $self->{Hub} || return $st_ctx->release; | ||||
| 275 | |||||
| 276 | my $meta = $chub->meta(__PACKAGE__, {}); | ||||
| 277 | if ($meta->{child}) { | ||||
| 278 | $self->croak("Can't call finalize() with child ($meta->{child}) active"); | ||||
| 279 | } | ||||
| 280 | |||||
| 281 | local $? = 0; # don't fail if $subtests happened to set $? nonzero | ||||
| 282 | |||||
| 283 | $self->{Stack}->pop($chub); | ||||
| 284 | |||||
| 285 | $self->find_TODO($meta->{TODO_PKG}, 1, $meta->{TODO}); | ||||
| 286 | |||||
| 287 | my $parent = $self->parent; | ||||
| 288 | my $ctx = $parent->ctx; | ||||
| 289 | my $trace = $ctx->trace; | ||||
| 290 | delete $ctx->hub->meta(__PACKAGE__, {})->{child}; | ||||
| 291 | |||||
| 292 | $chub->finalize($trace->snapshot(hid => $chub->hid, nested => $chub->nested), 1) | ||||
| 293 | if $ok | ||||
| 294 | && $chub->count | ||||
| 295 | && !$chub->no_ending | ||||
| 296 | && !$chub->ended; | ||||
| 297 | |||||
| 298 | my $plan = $chub->plan || 0; | ||||
| 299 | my $count = $chub->count; | ||||
| 300 | my $failed = $chub->failed; | ||||
| 301 | my $passed = $chub->is_passing; | ||||
| 302 | |||||
| 303 | my $num_extra = $plan =~ m/\D/ ? 0 : $count - $plan; | ||||
| 304 | if ($count && $num_extra != 0) { | ||||
| 305 | my $s = $plan == 1 ? '' : 's'; | ||||
| 306 | $st_ctx->diag(<<"FAIL"); | ||||
| 307 | Looks like you planned $plan test$s but ran $count. | ||||
| 308 | FAIL | ||||
| 309 | } | ||||
| 310 | |||||
| 311 | if ($failed) { | ||||
| 312 | my $s = $failed == 1 ? '' : 's'; | ||||
| 313 | |||||
| 314 | my $qualifier = $num_extra == 0 ? '' : ' run'; | ||||
| 315 | |||||
| 316 | $st_ctx->diag(<<"FAIL"); | ||||
| 317 | Looks like you failed $failed test$s of $count$qualifier. | ||||
| 318 | FAIL | ||||
| 319 | } | ||||
| 320 | |||||
| 321 | if (!$passed && !$failed && $count && !$num_extra) { | ||||
| 322 | $st_ctx->diag(<<"FAIL"); | ||||
| 323 | All assertions inside the subtest passed, but errors were encountered. | ||||
| 324 | FAIL | ||||
| 325 | } | ||||
| 326 | |||||
| 327 | $st_ctx->release; | ||||
| 328 | |||||
| 329 | unless ($chub->bailed_out) { | ||||
| 330 | my $plan = $chub->plan; | ||||
| 331 | if ( $plan && $plan eq 'SKIP' ) { | ||||
| 332 | $parent->skip($chub->skip_reason, $meta->{Name}); | ||||
| 333 | } | ||||
| 334 | elsif ( !$chub->count ) { | ||||
| 335 | $parent->ok( 0, sprintf q[No tests run for subtest "%s"], $meta->{Name} ); | ||||
| 336 | } | ||||
| 337 | else { | ||||
| 338 | $parent->{subevents} = $meta->{subevents}; | ||||
| 339 | $parent->{subtest_id} = $meta->{subtest_id}; | ||||
| 340 | $parent->{subtest_uuid} = $meta->{subtest_uuid}; | ||||
| 341 | $parent->{subtest_buffered} = $meta->{subtest_buffered}; | ||||
| 342 | $parent->ok( $chub->is_passing, $meta->{Name} ); | ||||
| 343 | } | ||||
| 344 | } | ||||
| 345 | |||||
| 346 | $ctx->release; | ||||
| 347 | return $chub->is_passing; | ||||
| 348 | } | ||||
| 349 | |||||
| 350 | sub subtest { | ||||
| 351 | my $self = shift; | ||||
| 352 | my ($name, $code, @args) = @_; | ||||
| 353 | my $ctx = $self->ctx; | ||||
| 354 | $ctx->throw("subtest()'s second argument must be a code ref") | ||||
| 355 | unless $code && reftype($code) eq 'CODE'; | ||||
| 356 | |||||
| 357 | $name ||= "Child of " . $self->name; | ||||
| 358 | |||||
| 359 | |||||
| 360 | $_->($name,$code,@args) | ||||
| 361 | for Test2::API::test2_list_pre_subtest_callbacks(); | ||||
| 362 | |||||
| 363 | $ctx->note("Subtest: $name"); | ||||
| 364 | |||||
| 365 | my $child = $self->child($name); | ||||
| 366 | |||||
| 367 | my $start_pid = $$; | ||||
| 368 | my $st_ctx; | ||||
| 369 | my ($ok, $err, $finished, $child_error); | ||||
| 370 | T2_SUBTEST_WRAPPER: { | ||||
| 371 | my $ctx = $self->ctx; | ||||
| 372 | $st_ctx = $ctx->snapshot; | ||||
| 373 | $ctx->release; | ||||
| 374 | $ok = eval { local $Level = 1; $code->(@args); 1 }; | ||||
| 375 | ($err, $child_error) = ($@, $?); | ||||
| 376 | |||||
| 377 | # They might have done 'BEGIN { skip_all => "whatever" }' | ||||
| 378 | if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { | ||||
| 379 | $ok = undef; | ||||
| 380 | $err = undef; | ||||
| 381 | } | ||||
| 382 | else { | ||||
| 383 | $finished = 1; | ||||
| 384 | } | ||||
| 385 | } | ||||
| 386 | |||||
| 387 | if ($start_pid != $$ && !$INC{'Test2/IPC.pm'}) { | ||||
| 388 | warn $ok ? "Forked inside subtest, but subtest never finished!\n" : $err; | ||||
| 389 | exit 255; | ||||
| 390 | } | ||||
| 391 | |||||
| 392 | my $trace = $ctx->trace; | ||||
| 393 | |||||
| 394 | if (!$finished) { | ||||
| 395 | if(my $bailed = $st_ctx->hub->bailed_out) { | ||||
| 396 | my $chub = $child->{Hub}; | ||||
| 397 | $self->{Stack}->pop($chub); | ||||
| 398 | $ctx->bail($bailed->reason); | ||||
| 399 | } | ||||
| 400 | my $code = $st_ctx->hub->exit_code; | ||||
| 401 | $ok = !$code; | ||||
| 402 | $err = "Subtest ended with exit code $code" if $code; | ||||
| 403 | } | ||||
| 404 | |||||
| 405 | my $st_hub = $st_ctx->hub; | ||||
| 406 | my $plan = $st_hub->plan; | ||||
| 407 | my $count = $st_hub->count; | ||||
| 408 | |||||
| 409 | if (!$count && (!defined($plan) || "$plan" ne 'SKIP')) { | ||||
| 410 | $st_ctx->plan(0) unless defined $plan; | ||||
| 411 | $st_ctx->diag('No tests run!'); | ||||
| 412 | } | ||||
| 413 | |||||
| 414 | $child->finalize($st_ctx->trace); | ||||
| 415 | |||||
| 416 | $ctx->release; | ||||
| 417 | |||||
| 418 | die $err unless $ok; | ||||
| 419 | |||||
| 420 | $? = $child_error if defined $child_error; | ||||
| 421 | |||||
| 422 | return $st_hub->is_passing; | ||||
| 423 | } | ||||
| 424 | |||||
| 425 | sub name { | ||||
| 426 | my $self = shift; | ||||
| 427 | my $ctx = $self->ctx; | ||||
| 428 | release $ctx, $ctx->hub->meta(__PACKAGE__, {})->{Name}; | ||||
| 429 | } | ||||
| 430 | |||||
| 431 | # spent 430µs (47+383) within Test::Builder::reset which was called:
# once (47µs+383µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] at line 146 | ||||
| 432 | 1 | 900ns | my ($self, %params) = @_; | ||
| 433 | |||||
| 434 | 1 | 700ns | 1 | 700ns | Test2::API::test2_unset_is_end(); # spent 700ns making 1 call to Test2::API::test2_unset_is_end |
| 435 | |||||
| 436 | # We leave this a global because it has to be localized and localizing | ||||
| 437 | # hash keys is just asking for pain. Also, it was documented. | ||||
| 438 | 1 | 200ns | $Level = 1; | ||
| 439 | |||||
| 440 | $self->{no_log_results} = $ENV{TEST_NO_LOG_RESULTS} ? 1 : 0 | ||||
| 441 | 1 | 200ns | unless $params{singleton}; | ||
| 442 | |||||
| 443 | 1 | 1µs | 1 | 2µs | $self->{Original_Pid} = Test2::API::test2_in_preload() ? -1 : $$; # spent 2µs making 1 call to Test2::API::test2_in_preload |
| 444 | |||||
| 445 | 1 | 1µs | 1 | 216µs | my $ctx = $self->ctx; # spent 216µs making 1 call to Test::Builder::ctx |
| 446 | 1 | 900ns | 1 | 2µs | my $hub = $ctx->hub; # spent 2µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 447 | 1 | 800ns | 1 | 6µs | $ctx->release; # spent 6µs making 1 call to Test2::API::Context::release |
| 448 | 1 | 200ns | unless ($params{singleton}) { | ||
| 449 | $hub->reset_state(); | ||||
| 450 | $hub->_tb_reset(); | ||||
| 451 | } | ||||
| 452 | |||||
| 453 | 1 | 7µs | 2 | 32µs | $ctx = $self->ctx; # spent 32µs making 1 call to Test::Builder::ctx
# spent 700ns making 1 call to Test2::API::Context::DESTROY |
| 454 | |||||
| 455 | 1 | 2µs | 2 | 7µs | my $meta = $ctx->hub->meta(__PACKAGE__, {}); # spent 6µs making 1 call to Test2::Util::ExternalMeta::meta
# spent 800ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 456 | %$meta = ( | ||||
| 457 | Name => $0, | ||||
| 458 | Ending => 0, | ||||
| 459 | Done_Testing => undef, | ||||
| 460 | Skip_All => 0, | ||||
| 461 | Test_Results => [], | ||||
| 462 | parent => $meta->{parent}, | ||||
| 463 | 1 | 2µs | ); | ||
| 464 | |||||
| 465 | 1 | 300ns | $self->{Exported_To} = undef unless $params{singleton}; | ||
| 466 | |||||
| 467 | 1 | 400ns | $self->{Orig_Handles} ||= do { | ||
| 468 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 1µs making 1 call to Test2::Hub::format
# spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 469 | 1 | 100ns | my $out; | ||
| 470 | 1 | 8µs | 2 | 1µs | if ($format && $format->isa('Test2::Formatter::TAP')) { # spent 600ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
# spent 600ns making 1 call to UNIVERSAL::isa |
| 471 | $out = $format->handles; | ||||
| 472 | } | ||||
| 473 | 1 | 800ns | $out ? [@$out] : []; | ||
| 474 | }; | ||||
| 475 | |||||
| 476 | 1 | 900ns | 1 | 48µs | $self->use_numbers(1); # spent 48µs making 1 call to Test::Builder::use_numbers |
| 477 | 1 | 200ns | $self->no_header(0) unless $params{singleton}; | ||
| 478 | 1 | 100ns | $self->no_ending(0) unless $params{singleton}; | ||
| 479 | 1 | 800ns | 1 | 59µs | $self->reset_outputs; # spent 59µs making 1 call to Test::Builder::reset_outputs |
| 480 | |||||
| 481 | 1 | 1µs | 1 | 5µs | $ctx->release; # spent 5µs making 1 call to Test2::API::Context::release |
| 482 | |||||
| 483 | 1 | 4µs | 1 | 500ns | return; # spent 500ns making 1 call to Test2::API::Context::DESTROY |
| 484 | } | ||||
| 485 | |||||
| 486 | |||||
| 487 | 1 | 1µs | my %plan_cmds = ( | ||
| 488 | no_plan => \&no_plan, | ||||
| 489 | skip_all => \&skip_all, | ||||
| 490 | tests => \&_plan_tests, | ||||
| 491 | ); | ||||
| 492 | |||||
| 493 | # spent 1µs within Test::Builder::plan which was called:
# once (1µs+0s) by Test::Builder::Module::import at line 92 of Test/Builder/Module.pm | ||||
| 494 | 1 | 300ns | my( $self, $cmd, $arg ) = @_; | ||
| 495 | |||||
| 496 | 1 | 1µs | return unless $cmd; | ||
| 497 | |||||
| 498 | my $ctx = $self->ctx; | ||||
| 499 | my $hub = $ctx->hub; | ||||
| 500 | |||||
| 501 | $ctx->throw("You tried to plan twice") if $hub->plan; | ||||
| 502 | |||||
| 503 | local $Level = $Level + 1; | ||||
| 504 | |||||
| 505 | if( my $method = $plan_cmds{$cmd} ) { | ||||
| 506 | local $Level = $Level + 1; | ||||
| 507 | $self->$method($arg); | ||||
| 508 | } | ||||
| 509 | else { | ||||
| 510 | my @args = grep { defined } ( $cmd, $arg ); | ||||
| 511 | $ctx->throw("plan() doesn't understand @args"); | ||||
| 512 | } | ||||
| 513 | |||||
| 514 | release $ctx, 1; | ||||
| 515 | } | ||||
| 516 | |||||
| 517 | |||||
| 518 | sub _plan_tests { | ||||
| 519 | my($self, $arg) = @_; | ||||
| 520 | |||||
| 521 | my $ctx = $self->ctx; | ||||
| 522 | |||||
| 523 | if($arg) { | ||||
| 524 | local $Level = $Level + 1; | ||||
| 525 | $self->expected_tests($arg); | ||||
| 526 | } | ||||
| 527 | elsif( !defined $arg ) { | ||||
| 528 | $ctx->throw("Got an undefined number of tests"); | ||||
| 529 | } | ||||
| 530 | else { | ||||
| 531 | $ctx->throw("You said to run 0 tests"); | ||||
| 532 | } | ||||
| 533 | |||||
| 534 | $ctx->release; | ||||
| 535 | } | ||||
| 536 | |||||
| 537 | |||||
| 538 | # spent 29µs (11+18) within Test::Builder::expected_tests which was called:
# once (11µs+18µs) by Test::Builder::done_testing at line 611 | ||||
| 539 | 1 | 200ns | my $self = shift; | ||
| 540 | 1 | 300ns | my($max) = @_; | ||
| 541 | |||||
| 542 | 1 | 900ns | 1 | 15µs | my $ctx = $self->ctx; # spent 15µs making 1 call to Test::Builder::ctx |
| 543 | |||||
| 544 | 1 | 300ns | if(@_) { | ||
| 545 | $self->croak("Number of tests must be a positive integer. You gave it '$max'") | ||||
| 546 | unless $max =~ /^\+?\d+$/; | ||||
| 547 | |||||
| 548 | $ctx->plan($max); | ||||
| 549 | } | ||||
| 550 | |||||
| 551 | 1 | 800ns | 1 | 400ns | my $hub = $ctx->hub; # spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 552 | |||||
| 553 | 1 | 700ns | 1 | 2µs | $ctx->release; # spent 2µs making 1 call to Test2::API::Context::release |
| 554 | |||||
| 555 | 1 | 700ns | 1 | 700ns | my $plan = $hub->plan; # spent 700ns making 1 call to Test2::Hub::plan |
| 556 | 1 | 3µs | 1 | 400ns | return 0 unless $plan; # spent 400ns making 1 call to Test2::API::Context::DESTROY |
| 557 | return 0 if $plan =~ m/\D/; | ||||
| 558 | return $plan; | ||||
| 559 | } | ||||
| 560 | |||||
| 561 | |||||
| 562 | sub no_plan { | ||||
| 563 | my($self, $arg) = @_; | ||||
| 564 | |||||
| 565 | my $ctx = $self->ctx; | ||||
| 566 | |||||
| 567 | if (defined $ctx->hub->plan) { | ||||
| 568 | warn "Plan already set, no_plan() is a no-op, this will change to a hard failure in the future."; | ||||
| 569 | $ctx->release; | ||||
| 570 | return; | ||||
| 571 | } | ||||
| 572 | |||||
| 573 | $ctx->alert("no_plan takes no arguments") if $arg; | ||||
| 574 | |||||
| 575 | $ctx->hub->plan('NO PLAN'); | ||||
| 576 | |||||
| 577 | release $ctx, 1; | ||||
| 578 | } | ||||
| 579 | |||||
| 580 | |||||
| 581 | # spent 353µs (45+309) within Test::Builder::done_testing which was called:
# once (45µs+309µs) by Test::More::done_testing at line 249 of Test/More.pm | ||||
| 582 | 1 | 400ns | my($self, $num_tests) = @_; | ||
| 583 | |||||
| 584 | 1 | 1µs | 1 | 30µs | my $ctx = $self->ctx; # spent 30µs making 1 call to Test::Builder::ctx |
| 585 | |||||
| 586 | 1 | 4µs | 2 | 9µs | my $meta = $ctx->hub->meta(__PACKAGE__, {}); # spent 7µs making 1 call to Test2::Util::ExternalMeta::meta
# spent 2µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 587 | |||||
| 588 | 1 | 600ns | if ($meta->{Done_Testing}) { | ||
| 589 | my ($file, $line) = @{$meta->{Done_Testing}}[1,2]; | ||||
| 590 | local $ctx->hub->{ended}; # OMG This is awful. | ||||
| 591 | $self->ok(0, "done_testing() was already called at $file line $line"); | ||||
| 592 | $ctx->release; | ||||
| 593 | return; | ||||
| 594 | } | ||||
| 595 | 1 | 4µs | 2 | 3µs | $meta->{Done_Testing} = [$ctx->trace->call]; # spent 2µs making 1 call to Test2::EventFacet::Trace::call
# spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 596 | |||||
| 597 | 1 | 2µs | 2 | 2µs | my $plan = $ctx->hub->plan; # spent 2µs making 1 call to Test2::Hub::plan
# spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 598 | 1 | 2µs | 2 | 1µs | my $count = $ctx->hub->count; # spent 1µs making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 550ns/call |
| 599 | |||||
| 600 | # If done_testing() specified the number of tests, shut off no_plan | ||||
| 601 | 1 | 1µs | if( defined $num_tests ) { | ||
| 602 | $ctx->plan($num_tests) if !$plan || $plan eq 'NO PLAN'; | ||||
| 603 | } | ||||
| 604 | elsif ($count && defined $num_tests && $count != $num_tests) { | ||||
| 605 | $self->ok(0, "planned to run @{[ $self->expected_tests ]} but done_testing() expects $num_tests"); | ||||
| 606 | } | ||||
| 607 | else { | ||||
| 608 | 1 | 2µs | 1 | 40µs | $num_tests = $self->current_test; # spent 40µs making 1 call to Test::Builder::current_test |
| 609 | } | ||||
| 610 | |||||
| 611 | 1 | 2µs | 1 | 29µs | if( $self->expected_tests && $num_tests != $self->expected_tests ) { # spent 29µs making 1 call to Test::Builder::expected_tests |
| 612 | $self->ok(0, "planned to run @{[ $self->expected_tests ]} ". | ||||
| 613 | "but done_testing() expects $num_tests"); | ||||
| 614 | } | ||||
| 615 | |||||
| 616 | 1 | 1µs | 2 | 700ns | $ctx->plan($num_tests) if $ctx->hub->plan && $ctx->hub->plan eq 'NO PLAN'; # spent 400ns making 1 call to Test2::Hub::plan
# spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 617 | |||||
| 618 | 1 | 3µs | 3 | 186µs | $ctx->hub->finalize($ctx->trace, 1); # spent 186µs making 1 call to Test2::Hub::finalize
# spent 600ns making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 300ns/call |
| 619 | |||||
| 620 | 1 | 6µs | 2 | 8µs | release $ctx, 1; # spent 7µs making 1 call to Test2::API::release
# spent 700ns making 1 call to Test2::API::Context::DESTROY |
| 621 | } | ||||
| 622 | |||||
| 623 | |||||
| 624 | sub has_plan { | ||||
| 625 | my $self = shift; | ||||
| 626 | |||||
| 627 | my $ctx = $self->ctx; | ||||
| 628 | my $plan = $ctx->hub->plan; | ||||
| 629 | $ctx->release; | ||||
| 630 | |||||
| 631 | return( $plan ) if $plan && $plan !~ m/\D/; | ||||
| 632 | return('no_plan') if $plan && $plan eq 'NO PLAN'; | ||||
| 633 | return(undef); | ||||
| 634 | } | ||||
| 635 | |||||
| 636 | |||||
| 637 | sub skip_all { | ||||
| 638 | my( $self, $reason ) = @_; | ||||
| 639 | |||||
| 640 | my $ctx = $self->ctx; | ||||
| 641 | |||||
| 642 | $ctx->hub->meta(__PACKAGE__, {})->{Skip_All} = $reason || 1; | ||||
| 643 | |||||
| 644 | # Work around old perl bug | ||||
| 645 | if ($] < 5.020000) { | ||||
| 646 | my $begin = 0; | ||||
| 647 | my $level = 0; | ||||
| 648 | while (my @call = caller($level++)) { | ||||
| 649 | last unless @call && $call[0]; | ||||
| 650 | next unless $call[3] =~ m/::BEGIN$/; | ||||
| 651 | $begin++; | ||||
| 652 | last; | ||||
| 653 | } | ||||
| 654 | # HACK! | ||||
| 655 | die 'Label not found for "last T2_SUBTEST_WRAPPER"' if $begin && $ctx->hub->meta(__PACKAGE__, {})->{parent}; | ||||
| 656 | } | ||||
| 657 | |||||
| 658 | $reason = "$reason" if defined $reason; | ||||
| 659 | |||||
| 660 | $ctx->plan(0, SKIP => $reason); | ||||
| 661 | } | ||||
| 662 | |||||
| 663 | |||||
| 664 | # spent 2µs within Test::Builder::exported_to which was called 2 times, avg 1µs/call:
# once (2µs+0s) by Test::Builder::Module::import at line 87 of Test/Builder/Module.pm
# once (800ns+0s) by Test::More::import_extra at line 208 of Test/More.pm | ||||
| 665 | 2 | 700ns | my( $self, $pack ) = @_; | ||
| 666 | |||||
| 667 | 2 | 600ns | if( defined $pack ) { | ||
| 668 | $self->{Exported_To} = $pack; | ||||
| 669 | } | ||||
| 670 | 2 | 3µs | return $self->{Exported_To}; | ||
| 671 | } | ||||
| 672 | |||||
| 673 | |||||
| 674 | # spent 256µs (40+215) within Test::Builder::ok which was called:
# once (40µs+215µs) by Test::More::ok at line 323 of Test/More.pm | ||||
| 675 | 1 | 500ns | my( $self, $test, $name ) = @_; | ||
| 676 | |||||
| 677 | 1 | 2µs | 1 | 66µs | my $ctx = $self->ctx; # spent 66µs making 1 call to Test::Builder::ctx |
| 678 | |||||
| 679 | # $test might contain an object which we don't want to accidentally | ||||
| 680 | # store, so we turn it into a boolean. | ||||
| 681 | 1 | 500ns | $test = $test ? 1 : 0; | ||
| 682 | |||||
| 683 | # In case $name is a string overloaded object, force it to stringify. | ||||
| 684 | 2 | 73µs | 2 | 36µs | # spent 21µs (5+15) within Test::Builder::BEGIN@684 which was called:
# once (5µs+15µs) by Test::Builder::Module::BEGIN@5 at line 684 # spent 21µs making 1 call to Test::Builder::BEGIN@684
# spent 15µs making 1 call to warnings::unimport |
| 685 | 1 | 300ns | $name = "$name" if defined $name; | ||
| 686 | |||||
| 687 | # Profiling showed that the regex here was a huge time waster, doing the | ||||
| 688 | # numeric addition first cuts our profile time from ~300ms to ~50ms | ||||
| 689 | 1 | 1µs | $self->diag(<<" ERR") if 0 + $name && $name =~ /^[\d\s]+$/; | ||
| 690 | You named your test '$name'. You shouldn't use numbers for your test names. | ||||
| 691 | Very confusing. | ||||
| 692 | ERR | ||||
| 693 | 2 | 338µs | 2 | 47µs | # spent 26µs (4+21) within Test::Builder::BEGIN@693 which was called:
# once (4µs+21µs) by Test::Builder::Module::BEGIN@5 at line 693 # spent 26µs making 1 call to Test::Builder::BEGIN@693
# spent 21µs making 1 call to warnings::import |
| 694 | |||||
| 695 | 1 | 400ns | my $trace = $ctx->{trace}; | ||
| 696 | 1 | 400ns | my $hub = $ctx->{hub}; | ||
| 697 | |||||
| 698 | 1 | 3µs | my $result = { | ||
| 699 | ok => $test, | ||||
| 700 | actual_ok => $test, | ||||
| 701 | reason => '', | ||||
| 702 | type => '', | ||||
| 703 | (name => defined($name) ? $name : ''), | ||||
| 704 | }; | ||||
| 705 | |||||
| 706 | 1 | 2µs | $hub->{_meta}->{+__PACKAGE__}->{Test_Results}[ $hub->{count} ] = $result unless $self->{no_log_results}; | ||
| 707 | |||||
| 708 | 1 | 300ns | my $orig_name = $name; | ||
| 709 | |||||
| 710 | 1 | 200ns | my @attrs; | ||
| 711 | 1 | 400ns | my $subevents = delete $self->{subevents}; | ||
| 712 | 1 | 400ns | my $subtest_id = delete $self->{subtest_id}; | ||
| 713 | 1 | 300ns | my $subtest_uuid = delete $self->{subtest_uuid}; | ||
| 714 | 1 | 300ns | my $subtest_buffered = delete $self->{subtest_buffered}; | ||
| 715 | 1 | 300ns | my $epkg = 'Test2::Event::Ok'; | ||
| 716 | 1 | 200ns | if ($subevents) { | ||
| 717 | $epkg = 'Test2::Event::Subtest'; | ||||
| 718 | push @attrs => (subevents => $subevents, subtest_id => $subtest_id, subtest_uuid => $subtest_uuid, buffered => $subtest_buffered); | ||||
| 719 | } | ||||
| 720 | |||||
| 721 | 1 | 9µs | my $e = bless { | ||
| 722 | trace => bless( {%$trace}, 'Test2::EventFacet::Trace'), | ||||
| 723 | pass => $test, | ||||
| 724 | name => $name, | ||||
| 725 | _meta => {'Test::Builder' => $result}, | ||||
| 726 | effective_pass => $test, | ||||
| 727 | @attrs, | ||||
| 728 | }, $epkg; | ||||
| 729 | 1 | 2µs | 1 | 139µs | $hub->send($e); # spent 139µs making 1 call to Test2::Hub::send |
| 730 | |||||
| 731 | 1 | 400ns | $self->_ok_debug($trace, $orig_name) unless($test); | ||
| 732 | |||||
| 733 | 1 | 2µs | 1 | 9µs | $ctx->release; # spent 9µs making 1 call to Test2::API::Context::release |
| 734 | 1 | 12µs | 1 | 2µs | return $test; # spent 2µs making 1 call to Test2::API::Context::DESTROY |
| 735 | } | ||||
| 736 | |||||
| 737 | sub _ok_debug { | ||||
| 738 | my $self = shift; | ||||
| 739 | my ($trace, $orig_name) = @_; | ||||
| 740 | |||||
| 741 | my $is_todo = $self->in_todo; | ||||
| 742 | |||||
| 743 | my $msg = $is_todo ? "Failed (TODO)" : "Failed"; | ||||
| 744 | |||||
| 745 | my (undef, $file, $line) = $trace->call; | ||||
| 746 | if (defined $orig_name) { | ||||
| 747 | $self->diag(qq[ $msg test '$orig_name'\n at $file line $line.\n]); | ||||
| 748 | } | ||||
| 749 | else { | ||||
| 750 | $self->diag(qq[ $msg test at $file line $line.\n]); | ||||
| 751 | } | ||||
| 752 | } | ||||
| 753 | |||||
| 754 | sub _diag_fh { | ||||
| 755 | my $self = shift; | ||||
| 756 | local $Level = $Level + 1; | ||||
| 757 | return $self->in_todo ? $self->todo_output : $self->failure_output; | ||||
| 758 | } | ||||
| 759 | |||||
| 760 | sub _unoverload { | ||||
| 761 | my ($self, $type, $thing) = @_; | ||||
| 762 | |||||
| 763 | return unless ref $$thing; | ||||
| 764 | return unless blessed($$thing) || scalar $self->_try(sub{ $$thing->isa('UNIVERSAL') }); | ||||
| 765 | { | ||||
| 766 | local ($!, $@); | ||||
| 767 | require overload; | ||||
| 768 | } | ||||
| 769 | my $string_meth = overload::Method( $$thing, $type ) || return; | ||||
| 770 | $$thing = $$thing->$string_meth(undef, 0); | ||||
| 771 | } | ||||
| 772 | |||||
| 773 | sub _unoverload_str { | ||||
| 774 | my $self = shift; | ||||
| 775 | |||||
| 776 | $self->_unoverload( q[""], $_ ) for @_; | ||||
| 777 | } | ||||
| 778 | |||||
| 779 | sub _unoverload_num { | ||||
| 780 | my $self = shift; | ||||
| 781 | |||||
| 782 | $self->_unoverload( '0+', $_ ) for @_; | ||||
| 783 | |||||
| 784 | for my $val (@_) { | ||||
| 785 | next unless $self->_is_dualvar($$val); | ||||
| 786 | $$val = $$val + 0; | ||||
| 787 | } | ||||
| 788 | } | ||||
| 789 | |||||
| 790 | # This is a hack to detect a dualvar such as $! | ||||
| 791 | sub _is_dualvar { | ||||
| 792 | my( $self, $val ) = @_; | ||||
| 793 | |||||
| 794 | # Objects are not dualvars. | ||||
| 795 | return 0 if ref $val; | ||||
| 796 | |||||
| 797 | 2 | 796µs | 2 | 31µs | # spent 18µs (5+13) within Test::Builder::BEGIN@797 which was called:
# once (5µs+13µs) by Test::Builder::Module::BEGIN@5 at line 797 # spent 18µs making 1 call to Test::Builder::BEGIN@797
# spent 13µs making 1 call to warnings::unimport |
| 798 | my $numval = $val + 0; | ||||
| 799 | return ($numval != 0 and $numval ne $val ? 1 : 0); | ||||
| 800 | } | ||||
| 801 | |||||
| 802 | |||||
| 803 | sub is_eq { | ||||
| 804 | my( $self, $got, $expect, $name ) = @_; | ||||
| 805 | |||||
| 806 | my $ctx = $self->ctx; | ||||
| 807 | |||||
| 808 | local $Level = $Level + 1; | ||||
| 809 | |||||
| 810 | if( !defined $got || !defined $expect ) { | ||||
| 811 | # undef only matches undef and nothing else | ||||
| 812 | my $test = !defined $got && !defined $expect; | ||||
| 813 | |||||
| 814 | $self->ok( $test, $name ); | ||||
| 815 | $self->_is_diag( $got, 'eq', $expect ) unless $test; | ||||
| 816 | $ctx->release; | ||||
| 817 | return $test; | ||||
| 818 | } | ||||
| 819 | |||||
| 820 | release $ctx, $self->cmp_ok( $got, 'eq', $expect, $name ); | ||||
| 821 | } | ||||
| 822 | |||||
| 823 | |||||
| 824 | sub is_num { | ||||
| 825 | my( $self, $got, $expect, $name ) = @_; | ||||
| 826 | my $ctx = $self->ctx; | ||||
| 827 | local $Level = $Level + 1; | ||||
| 828 | |||||
| 829 | if( !defined $got || !defined $expect ) { | ||||
| 830 | # undef only matches undef and nothing else | ||||
| 831 | my $test = !defined $got && !defined $expect; | ||||
| 832 | |||||
| 833 | $self->ok( $test, $name ); | ||||
| 834 | $self->_is_diag( $got, '==', $expect ) unless $test; | ||||
| 835 | $ctx->release; | ||||
| 836 | return $test; | ||||
| 837 | } | ||||
| 838 | |||||
| 839 | release $ctx, $self->cmp_ok( $got, '==', $expect, $name ); | ||||
| 840 | } | ||||
| 841 | |||||
| 842 | |||||
| 843 | sub _diag_fmt { | ||||
| 844 | my( $self, $type, $val ) = @_; | ||||
| 845 | |||||
| 846 | if( defined $$val ) { | ||||
| 847 | if( $type eq 'eq' or $type eq 'ne' ) { | ||||
| 848 | # quote and force string context | ||||
| 849 | $$val = "'$$val'"; | ||||
| 850 | } | ||||
| 851 | else { | ||||
| 852 | # force numeric context | ||||
| 853 | $self->_unoverload_num($val); | ||||
| 854 | } | ||||
| 855 | } | ||||
| 856 | else { | ||||
| 857 | $$val = 'undef'; | ||||
| 858 | } | ||||
| 859 | |||||
| 860 | return; | ||||
| 861 | } | ||||
| 862 | |||||
| 863 | |||||
| 864 | sub _is_diag { | ||||
| 865 | my( $self, $got, $type, $expect ) = @_; | ||||
| 866 | |||||
| 867 | $self->_diag_fmt( $type, $_ ) for \$got, \$expect; | ||||
| 868 | |||||
| 869 | local $Level = $Level + 1; | ||||
| 870 | return $self->diag(<<"DIAGNOSTIC"); | ||||
| 871 | got: $got | ||||
| 872 | expected: $expect | ||||
| 873 | DIAGNOSTIC | ||||
| 874 | |||||
| 875 | } | ||||
| 876 | |||||
| 877 | sub _isnt_diag { | ||||
| 878 | my( $self, $got, $type ) = @_; | ||||
| 879 | |||||
| 880 | $self->_diag_fmt( $type, \$got ); | ||||
| 881 | |||||
| 882 | local $Level = $Level + 1; | ||||
| 883 | return $self->diag(<<"DIAGNOSTIC"); | ||||
| 884 | got: $got | ||||
| 885 | expected: anything else | ||||
| 886 | DIAGNOSTIC | ||||
| 887 | } | ||||
| 888 | |||||
| 889 | |||||
| 890 | sub isnt_eq { | ||||
| 891 | my( $self, $got, $dont_expect, $name ) = @_; | ||||
| 892 | my $ctx = $self->ctx; | ||||
| 893 | local $Level = $Level + 1; | ||||
| 894 | |||||
| 895 | if( !defined $got || !defined $dont_expect ) { | ||||
| 896 | # undef only matches undef and nothing else | ||||
| 897 | my $test = defined $got || defined $dont_expect; | ||||
| 898 | |||||
| 899 | $self->ok( $test, $name ); | ||||
| 900 | $self->_isnt_diag( $got, 'ne' ) unless $test; | ||||
| 901 | $ctx->release; | ||||
| 902 | return $test; | ||||
| 903 | } | ||||
| 904 | |||||
| 905 | release $ctx, $self->cmp_ok( $got, 'ne', $dont_expect, $name ); | ||||
| 906 | } | ||||
| 907 | |||||
| 908 | sub isnt_num { | ||||
| 909 | my( $self, $got, $dont_expect, $name ) = @_; | ||||
| 910 | my $ctx = $self->ctx; | ||||
| 911 | local $Level = $Level + 1; | ||||
| 912 | |||||
| 913 | if( !defined $got || !defined $dont_expect ) { | ||||
| 914 | # undef only matches undef and nothing else | ||||
| 915 | my $test = defined $got || defined $dont_expect; | ||||
| 916 | |||||
| 917 | $self->ok( $test, $name ); | ||||
| 918 | $self->_isnt_diag( $got, '!=' ) unless $test; | ||||
| 919 | $ctx->release; | ||||
| 920 | return $test; | ||||
| 921 | } | ||||
| 922 | |||||
| 923 | release $ctx, $self->cmp_ok( $got, '!=', $dont_expect, $name ); | ||||
| 924 | } | ||||
| 925 | |||||
| 926 | |||||
| 927 | sub like { | ||||
| 928 | my( $self, $thing, $regex, $name ) = @_; | ||||
| 929 | my $ctx = $self->ctx; | ||||
| 930 | |||||
| 931 | local $Level = $Level + 1; | ||||
| 932 | |||||
| 933 | release $ctx, $self->_regex_ok( $thing, $regex, '=~', $name ); | ||||
| 934 | } | ||||
| 935 | |||||
| 936 | sub unlike { | ||||
| 937 | my( $self, $thing, $regex, $name ) = @_; | ||||
| 938 | my $ctx = $self->ctx; | ||||
| 939 | |||||
| 940 | local $Level = $Level + 1; | ||||
| 941 | |||||
| 942 | release $ctx, $self->_regex_ok( $thing, $regex, '!~', $name ); | ||||
| 943 | } | ||||
| 944 | |||||
| 945 | |||||
| 946 | 1 | 3µs | my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" ); | ||
| 947 | |||||
| 948 | # Bad, these are not comparison operators. Should we include more? | ||||
| 949 | 1 | 3µs | my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "..."); | ||
| 950 | |||||
| 951 | sub cmp_ok { | ||||
| 952 | my( $self, $got, $type, $expect, $name ) = @_; | ||||
| 953 | my $ctx = $self->ctx; | ||||
| 954 | |||||
| 955 | if ($cmp_ok_bl{$type}) { | ||||
| 956 | $ctx->throw("$type is not a valid comparison operator in cmp_ok()"); | ||||
| 957 | } | ||||
| 958 | |||||
| 959 | my ($test, $succ); | ||||
| 960 | my $error; | ||||
| 961 | { | ||||
| 962 | ## no critic (BuiltinFunctions::ProhibitStringyEval) | ||||
| 963 | |||||
| 964 | local( $@, $!, $SIG{__DIE__} ); # isolate eval | ||||
| 965 | |||||
| 966 | my($pack, $file, $line) = $ctx->trace->call(); | ||||
| 967 | my $warning_bits = $ctx->trace->warning_bits; | ||||
| 968 | # convert this to a code string so the BEGIN doesn't have to close | ||||
| 969 | # over it, which can lead to issues with Devel::Cover | ||||
| 970 | my $bits_code = defined $warning_bits ? qq["\Q$warning_bits\E"] : 'undef'; | ||||
| 971 | |||||
| 972 | # This is so that warnings come out at the caller's level | ||||
| 973 | $succ = eval qq[ | ||||
| 974 | BEGIN {\${^WARNING_BITS} = $bits_code}; | ||||
| 975 | #line $line "(eval in cmp_ok) $file" | ||||
| 976 | \$test = (\$got $type \$expect); | ||||
| 977 | 1; | ||||
| 978 | ]; | ||||
| 979 | $error = $@; | ||||
| 980 | } | ||||
| 981 | local $Level = $Level + 1; | ||||
| 982 | my $ok = $self->ok( $test, $name ); | ||||
| 983 | |||||
| 984 | # Treat overloaded objects as numbers if we're asked to do a | ||||
| 985 | # numeric comparison. | ||||
| 986 | my $unoverload | ||||
| 987 | = $numeric_cmps{$type} | ||||
| 988 | ? '_unoverload_num' | ||||
| 989 | : '_unoverload_str'; | ||||
| 990 | |||||
| 991 | $self->diag(<<"END") unless $succ; | ||||
| 992 | An error occurred while using $type: | ||||
| 993 | ------------------------------------ | ||||
| 994 | $error | ||||
| 995 | ------------------------------------ | ||||
| 996 | END | ||||
| 997 | |||||
| 998 | unless($ok) { | ||||
| 999 | $self->$unoverload( \$got, \$expect ); | ||||
| 1000 | |||||
| 1001 | if( $type =~ /^(eq|==)$/ ) { | ||||
| 1002 | $self->_is_diag( $got, $type, $expect ); | ||||
| 1003 | } | ||||
| 1004 | elsif( $type =~ /^(ne|!=)$/ ) { | ||||
| 1005 | if (defined($got) xor defined($expect)) { | ||||
| 1006 | $self->_cmp_diag( $got, $type, $expect ); | ||||
| 1007 | } | ||||
| 1008 | else { | ||||
| 1009 | $self->_isnt_diag( $got, $type ); | ||||
| 1010 | } | ||||
| 1011 | } | ||||
| 1012 | else { | ||||
| 1013 | $self->_cmp_diag( $got, $type, $expect ); | ||||
| 1014 | } | ||||
| 1015 | } | ||||
| 1016 | return release $ctx, $ok; | ||||
| 1017 | } | ||||
| 1018 | |||||
| 1019 | sub _cmp_diag { | ||||
| 1020 | my( $self, $got, $type, $expect ) = @_; | ||||
| 1021 | |||||
| 1022 | $got = defined $got ? "'$got'" : 'undef'; | ||||
| 1023 | $expect = defined $expect ? "'$expect'" : 'undef'; | ||||
| 1024 | |||||
| 1025 | local $Level = $Level + 1; | ||||
| 1026 | return $self->diag(<<"DIAGNOSTIC"); | ||||
| 1027 | $got | ||||
| 1028 | $type | ||||
| 1029 | $expect | ||||
| 1030 | DIAGNOSTIC | ||||
| 1031 | } | ||||
| 1032 | |||||
| 1033 | sub _caller_context { | ||||
| 1034 | my $self = shift; | ||||
| 1035 | |||||
| 1036 | my( $pack, $file, $line ) = $self->caller(1); | ||||
| 1037 | |||||
| 1038 | my $code = ''; | ||||
| 1039 | $code .= "#line $line $file\n" if defined $file and defined $line; | ||||
| 1040 | |||||
| 1041 | return $code; | ||||
| 1042 | } | ||||
| 1043 | |||||
| 1044 | |||||
| 1045 | sub BAIL_OUT { | ||||
| 1046 | my( $self, $reason ) = @_; | ||||
| 1047 | |||||
| 1048 | my $ctx = $self->ctx; | ||||
| 1049 | |||||
| 1050 | $self->{Bailed_Out} = 1; | ||||
| 1051 | |||||
| 1052 | $ctx->bail($reason); | ||||
| 1053 | } | ||||
| 1054 | |||||
| 1055 | |||||
| 1056 | { | ||||
| 1057 | 3 | 439µs | 2 | 32µs | # spent 19µs (5+14) within Test::Builder::BEGIN@1057 which was called:
# once (5µs+14µs) by Test::Builder::Module::BEGIN@5 at line 1057 # spent 19µs making 1 call to Test::Builder::BEGIN@1057
# spent 14µs making 1 call to warnings::unimport |
| 1058 | 1 | 800ns | *BAILOUT = \&BAIL_OUT; | ||
| 1059 | } | ||||
| 1060 | |||||
| 1061 | sub skip { | ||||
| 1062 | my( $self, $why, $name ) = @_; | ||||
| 1063 | $why ||= ''; | ||||
| 1064 | $name = '' unless defined $name; | ||||
| 1065 | $self->_unoverload_str( \$why ); | ||||
| 1066 | |||||
| 1067 | my $ctx = $self->ctx; | ||||
| 1068 | |||||
| 1069 | $name = "$name"; | ||||
| 1070 | $why = "$why"; | ||||
| 1071 | |||||
| 1072 | $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. | ||||
| 1073 | $name =~ s{\n}{\n# }sg; | ||||
| 1074 | $why =~ s{\n}{\n# }sg; | ||||
| 1075 | |||||
| 1076 | $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}[ $ctx->hub->count ] = { | ||||
| 1077 | 'ok' => 1, | ||||
| 1078 | actual_ok => 1, | ||||
| 1079 | name => $name, | ||||
| 1080 | type => 'skip', | ||||
| 1081 | reason => $why, | ||||
| 1082 | } unless $self->{no_log_results}; | ||||
| 1083 | |||||
| 1084 | my $tctx = $ctx->snapshot; | ||||
| 1085 | $tctx->skip('', $why); | ||||
| 1086 | |||||
| 1087 | return release $ctx, 1; | ||||
| 1088 | } | ||||
| 1089 | |||||
| 1090 | |||||
| 1091 | sub todo_skip { | ||||
| 1092 | my( $self, $why ) = @_; | ||||
| 1093 | $why ||= ''; | ||||
| 1094 | |||||
| 1095 | my $ctx = $self->ctx; | ||||
| 1096 | |||||
| 1097 | $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}[ $ctx->hub->count ] = { | ||||
| 1098 | 'ok' => 1, | ||||
| 1099 | actual_ok => 0, | ||||
| 1100 | name => '', | ||||
| 1101 | type => 'todo_skip', | ||||
| 1102 | reason => $why, | ||||
| 1103 | } unless $self->{no_log_results}; | ||||
| 1104 | |||||
| 1105 | $why =~ s{\n}{\n# }sg; | ||||
| 1106 | my $tctx = $ctx->snapshot; | ||||
| 1107 | $tctx->send_event( 'Skip', todo => $why, todo_diag => 1, reason => $why, pass => 0); | ||||
| 1108 | |||||
| 1109 | return release $ctx, 1; | ||||
| 1110 | } | ||||
| 1111 | |||||
| 1112 | |||||
| 1113 | sub maybe_regex { | ||||
| 1114 | my( $self, $regex ) = @_; | ||||
| 1115 | my $usable_regex = undef; | ||||
| 1116 | |||||
| 1117 | return $usable_regex unless defined $regex; | ||||
| 1118 | |||||
| 1119 | my( $re, $opts ); | ||||
| 1120 | |||||
| 1121 | # Check for qr/foo/ | ||||
| 1122 | if( _is_qr($regex) ) { | ||||
| 1123 | $usable_regex = $regex; | ||||
| 1124 | } | ||||
| 1125 | # Check for '/foo/' or 'm,foo,' | ||||
| 1126 | elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or | ||||
| 1127 | ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx | ||||
| 1128 | ) | ||||
| 1129 | { | ||||
| 1130 | $usable_regex = length $opts ? "(?$opts)$re" : $re; | ||||
| 1131 | } | ||||
| 1132 | |||||
| 1133 | return $usable_regex; | ||||
| 1134 | } | ||||
| 1135 | |||||
| 1136 | sub _is_qr { | ||||
| 1137 | my $regex = shift; | ||||
| 1138 | |||||
| 1139 | # is_regexp() checks for regexes in a robust manner, say if they're | ||||
| 1140 | # blessed. | ||||
| 1141 | return re::is_regexp($regex) if defined &re::is_regexp; | ||||
| 1142 | return ref $regex eq 'Regexp'; | ||||
| 1143 | } | ||||
| 1144 | |||||
| 1145 | sub _regex_ok { | ||||
| 1146 | my( $self, $thing, $regex, $cmp, $name ) = @_; | ||||
| 1147 | |||||
| 1148 | my $ok = 0; | ||||
| 1149 | my $usable_regex = $self->maybe_regex($regex); | ||||
| 1150 | unless( defined $usable_regex ) { | ||||
| 1151 | local $Level = $Level + 1; | ||||
| 1152 | $ok = $self->ok( 0, $name ); | ||||
| 1153 | $self->diag(" '$regex' doesn't look much like a regex to me."); | ||||
| 1154 | return $ok; | ||||
| 1155 | } | ||||
| 1156 | |||||
| 1157 | { | ||||
| 1158 | my $test; | ||||
| 1159 | my $context = $self->_caller_context; | ||||
| 1160 | |||||
| 1161 | { | ||||
| 1162 | ## no critic (BuiltinFunctions::ProhibitStringyEval) | ||||
| 1163 | |||||
| 1164 | local( $@, $!, $SIG{__DIE__} ); # isolate eval | ||||
| 1165 | |||||
| 1166 | # No point in issuing an uninit warning, they'll see it in the diagnostics | ||||
| 1167 | 2 | 250µs | 2 | 32µs | # spent 18µs (5+13) within Test::Builder::BEGIN@1167 which was called:
# once (5µs+13µs) by Test::Builder::Module::BEGIN@5 at line 1167 # spent 18µs making 1 call to Test::Builder::BEGIN@1167
# spent 13µs making 1 call to warnings::unimport |
| 1168 | |||||
| 1169 | $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0}; | ||||
| 1170 | } | ||||
| 1171 | |||||
| 1172 | $test = !$test if $cmp eq '!~'; | ||||
| 1173 | |||||
| 1174 | local $Level = $Level + 1; | ||||
| 1175 | $ok = $self->ok( $test, $name ); | ||||
| 1176 | } | ||||
| 1177 | |||||
| 1178 | unless($ok) { | ||||
| 1179 | $thing = defined $thing ? "'$thing'" : 'undef'; | ||||
| 1180 | my $match = $cmp eq '=~' ? "doesn't match" : "matches"; | ||||
| 1181 | |||||
| 1182 | local $Level = $Level + 1; | ||||
| 1183 | $self->diag( sprintf <<'DIAGNOSTIC', $thing, $match, $regex ); | ||||
| 1184 | %s | ||||
| 1185 | %13s '%s' | ||||
| 1186 | DIAGNOSTIC | ||||
| 1187 | |||||
| 1188 | } | ||||
| 1189 | |||||
| 1190 | return $ok; | ||||
| 1191 | } | ||||
| 1192 | |||||
| 1193 | |||||
| 1194 | sub is_fh { | ||||
| 1195 | my $self = shift; | ||||
| 1196 | my $maybe_fh = shift; | ||||
| 1197 | return 0 unless defined $maybe_fh; | ||||
| 1198 | |||||
| 1199 | return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref | ||||
| 1200 | return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob | ||||
| 1201 | |||||
| 1202 | return eval { $maybe_fh->isa("IO::Handle") } || | ||||
| 1203 | eval { tied($maybe_fh)->can('TIEHANDLE') }; | ||||
| 1204 | } | ||||
| 1205 | |||||
| 1206 | |||||
| 1207 | sub level { | ||||
| 1208 | my( $self, $level ) = @_; | ||||
| 1209 | |||||
| 1210 | if( defined $level ) { | ||||
| 1211 | $Level = $level; | ||||
| 1212 | } | ||||
| 1213 | return $Level; | ||||
| 1214 | } | ||||
| 1215 | |||||
| 1216 | |||||
| 1217 | # spent 48µs (16+33) within Test::Builder::use_numbers which was called:
# once (16µs+33µs) by Test::Builder::reset at line 476 | ||||
| 1218 | 1 | 200ns | my( $self, $use_nums ) = @_; | ||
| 1219 | |||||
| 1220 | 1 | 700ns | 1 | 23µs | my $ctx = $self->ctx; # spent 23µs making 1 call to Test::Builder::ctx |
| 1221 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 800ns making 1 call to Test2::Hub::format
# spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1222 | 1 | 5µs | 2 | 2µs | unless ($format && $format->can('no_numbers') && $format->can('set_no_numbers')) { # spent 2µs making 2 calls to UNIVERSAL::can, avg 1µs/call |
| 1223 | warn "The current formatter does not support 'use_numbers'" if $format; | ||||
| 1224 | return release $ctx, 0; | ||||
| 1225 | } | ||||
| 1226 | |||||
| 1227 | 1 | 800ns | 1 | 1µs | $format->set_no_numbers(!$use_nums) if defined $use_nums; # spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:85] |
| 1228 | |||||
| 1229 | 1 | 4µs | 3 | 6µs | return release $ctx, $format->no_numbers ? 0 : 1; # spent 4µs making 1 call to Test2::API::release
# spent 600ns making 1 call to Test2::API::Context::DESTROY
# spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1230 | } | ||||
| 1231 | |||||
| 1232 | # spent 12µs within Test::Builder::BEGIN@1232 which was called:
# once (12µs+0s) by Test::Builder::Module::BEGIN@5 at line 1254 | ||||
| 1233 | 1 | 2µs | for my $method (qw(no_header no_diag)) { | ||
| 1234 | 2 | 600ns | my $set = "set_$method"; | ||
| 1235 | my $code = sub { | ||||
| 1236 | my( $self, $no ) = @_; | ||||
| 1237 | |||||
| 1238 | my $ctx = $self->ctx; | ||||
| 1239 | my $format = $ctx->hub->format; | ||||
| 1240 | unless ($format && $format->can($set)) { | ||||
| 1241 | warn "The current formatter does not support '$method'" if $format; | ||||
| 1242 | $ctx->release; | ||||
| 1243 | return | ||||
| 1244 | } | ||||
| 1245 | |||||
| 1246 | $format->$set($no) if defined $no; | ||||
| 1247 | |||||
| 1248 | return release $ctx, $format->$method ? 1 : 0; | ||||
| 1249 | 2 | 6µs | }; | ||
| 1250 | |||||
| 1251 | 2 | 28µs | 2 | 14µs | # spent 10µs (6+4) within Test::Builder::BEGIN@1251 which was called:
# once (6µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1251 # spent 10µs making 1 call to Test::Builder::BEGIN@1251
# spent 4µs making 1 call to strict::unimport |
| 1252 | 2 | 3µs | *$method = $code; | ||
| 1253 | } | ||||
| 1254 | 1 | 735µs | 1 | 12µs | } # spent 12µs making 1 call to Test::Builder::BEGIN@1232 |
| 1255 | |||||
| 1256 | sub no_ending { | ||||
| 1257 | my( $self, $no ) = @_; | ||||
| 1258 | |||||
| 1259 | my $ctx = $self->ctx; | ||||
| 1260 | |||||
| 1261 | $ctx->hub->set_no_ending($no) if defined $no; | ||||
| 1262 | |||||
| 1263 | return release $ctx, $ctx->hub->no_ending; | ||||
| 1264 | } | ||||
| 1265 | |||||
| 1266 | sub diag { | ||||
| 1267 | my $self = shift; | ||||
| 1268 | return unless @_; | ||||
| 1269 | |||||
| 1270 | my $text = join '' => map {defined($_) ? $_ : 'undef'} @_; | ||||
| 1271 | |||||
| 1272 | if (Test2::API::test2_in_preload()) { | ||||
| 1273 | chomp($text); | ||||
| 1274 | $text =~ s/^/# /msg; | ||||
| 1275 | print STDERR $text, "\n"; | ||||
| 1276 | return 0; | ||||
| 1277 | } | ||||
| 1278 | |||||
| 1279 | my $ctx = $self->ctx; | ||||
| 1280 | $ctx->diag($text); | ||||
| 1281 | $ctx->release; | ||||
| 1282 | return 0; | ||||
| 1283 | } | ||||
| 1284 | |||||
| 1285 | |||||
| 1286 | sub note { | ||||
| 1287 | my $self = shift; | ||||
| 1288 | return unless @_; | ||||
| 1289 | |||||
| 1290 | my $text = join '' => map {defined($_) ? $_ : 'undef'} @_; | ||||
| 1291 | |||||
| 1292 | if (Test2::API::test2_in_preload()) { | ||||
| 1293 | chomp($text); | ||||
| 1294 | $text =~ s/^/# /msg; | ||||
| 1295 | print STDOUT $text, "\n"; | ||||
| 1296 | return 0; | ||||
| 1297 | } | ||||
| 1298 | |||||
| 1299 | my $ctx = $self->ctx; | ||||
| 1300 | $ctx->note($text); | ||||
| 1301 | $ctx->release; | ||||
| 1302 | return 0; | ||||
| 1303 | } | ||||
| 1304 | |||||
| 1305 | |||||
| 1306 | sub explain { | ||||
| 1307 | my $self = shift; | ||||
| 1308 | |||||
| 1309 | local ($@, $!); | ||||
| 1310 | require Data::Dumper; | ||||
| 1311 | |||||
| 1312 | return map { | ||||
| 1313 | ref $_ | ||||
| 1314 | ? do { | ||||
| 1315 | my $dumper = Data::Dumper->new( [$_] ); | ||||
| 1316 | $dumper->Indent(1)->Terse(1); | ||||
| 1317 | $dumper->Sortkeys(1) if $dumper->can("Sortkeys"); | ||||
| 1318 | $dumper->Dump; | ||||
| 1319 | } | ||||
| 1320 | : $_ | ||||
| 1321 | } @_; | ||||
| 1322 | } | ||||
| 1323 | |||||
| 1324 | |||||
| 1325 | sub output { | ||||
| 1326 | my( $self, $fh ) = @_; | ||||
| 1327 | |||||
| 1328 | my $ctx = $self->ctx; | ||||
| 1329 | my $format = $ctx->hub->format; | ||||
| 1330 | $ctx->release; | ||||
| 1331 | return unless $format && $format->isa('Test2::Formatter::TAP'); | ||||
| 1332 | |||||
| 1333 | $format->handles->[Test2::Formatter::TAP::OUT_STD()] = $self->_new_fh($fh) | ||||
| 1334 | if defined $fh; | ||||
| 1335 | |||||
| 1336 | return $format->handles->[Test2::Formatter::TAP::OUT_STD()]; | ||||
| 1337 | } | ||||
| 1338 | |||||
| 1339 | sub failure_output { | ||||
| 1340 | my( $self, $fh ) = @_; | ||||
| 1341 | |||||
| 1342 | my $ctx = $self->ctx; | ||||
| 1343 | my $format = $ctx->hub->format; | ||||
| 1344 | $ctx->release; | ||||
| 1345 | return unless $format && $format->isa('Test2::Formatter::TAP'); | ||||
| 1346 | |||||
| 1347 | $format->handles->[Test2::Formatter::TAP::OUT_ERR()] = $self->_new_fh($fh) | ||||
| 1348 | if defined $fh; | ||||
| 1349 | |||||
| 1350 | return $format->handles->[Test2::Formatter::TAP::OUT_ERR()]; | ||||
| 1351 | } | ||||
| 1352 | |||||
| 1353 | sub todo_output { | ||||
| 1354 | my( $self, $fh ) = @_; | ||||
| 1355 | |||||
| 1356 | my $ctx = $self->ctx; | ||||
| 1357 | my $format = $ctx->hub->format; | ||||
| 1358 | $ctx->release; | ||||
| 1359 | return unless $format && $format->isa('Test::Builder::Formatter'); | ||||
| 1360 | |||||
| 1361 | $format->handles->[Test::Builder::Formatter::OUT_TODO()] = $self->_new_fh($fh) | ||||
| 1362 | if defined $fh; | ||||
| 1363 | |||||
| 1364 | return $format->handles->[Test::Builder::Formatter::OUT_TODO()]; | ||||
| 1365 | } | ||||
| 1366 | |||||
| 1367 | sub _new_fh { | ||||
| 1368 | my $self = shift; | ||||
| 1369 | my($file_or_fh) = shift; | ||||
| 1370 | |||||
| 1371 | my $fh; | ||||
| 1372 | if( $self->is_fh($file_or_fh) ) { | ||||
| 1373 | $fh = $file_or_fh; | ||||
| 1374 | } | ||||
| 1375 | elsif( ref $file_or_fh eq 'SCALAR' ) { | ||||
| 1376 | # Scalar refs as filehandles was added in 5.8. | ||||
| 1377 | if( $] >= 5.008 ) { | ||||
| 1378 | open $fh, ">>", $file_or_fh | ||||
| 1379 | or $self->croak("Can't open scalar ref $file_or_fh: $!"); | ||||
| 1380 | } | ||||
| 1381 | # Emulate scalar ref filehandles with a tie. | ||||
| 1382 | else { | ||||
| 1383 | $fh = Test::Builder::IO::Scalar->new($file_or_fh) | ||||
| 1384 | or $self->croak("Can't tie scalar ref $file_or_fh"); | ||||
| 1385 | } | ||||
| 1386 | } | ||||
| 1387 | else { | ||||
| 1388 | open $fh, ">", $file_or_fh | ||||
| 1389 | or $self->croak("Can't open test output log $file_or_fh: $!"); | ||||
| 1390 | _autoflush($fh); | ||||
| 1391 | } | ||||
| 1392 | |||||
| 1393 | return $fh; | ||||
| 1394 | } | ||||
| 1395 | |||||
| 1396 | sub _autoflush { | ||||
| 1397 | my($fh) = shift; | ||||
| 1398 | my $old_fh = select $fh; | ||||
| 1399 | $| = 1; | ||||
| 1400 | select $old_fh; | ||||
| 1401 | |||||
| 1402 | return; | ||||
| 1403 | } | ||||
| 1404 | |||||
| 1405 | |||||
| 1406 | # spent 59µs (28+31) within Test::Builder::reset_outputs which was called:
# once (28µs+31µs) by Test::Builder::reset at line 479 | ||||
| 1407 | 1 | 100ns | my $self = shift; | ||
| 1408 | |||||
| 1409 | 1 | 700ns | 1 | 17µs | my $ctx = $self->ctx; # spent 17µs making 1 call to Test::Builder::ctx |
| 1410 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 700ns making 1 call to Test2::Hub::format
# spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1411 | 1 | 400ns | 1 | 2µs | $ctx->release; # spent 2µs making 1 call to Test2::API::Context::release |
| 1412 | 1 | 2µs | 1 | 400ns | return unless $format && $format->isa('Test2::Formatter::TAP'); # spent 400ns making 1 call to UNIVERSAL::isa |
| 1413 | 1 | 2µs | 1 | 900ns | $format->set_handles([@{$self->{Orig_Handles}}]) if $self->{Orig_Handles}; # spent 900ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:85] |
| 1414 | |||||
| 1415 | 1 | 4µs | 1 | 9µs | return; # spent 9µs making 1 call to Test2::API::Context::DESTROY |
| 1416 | } | ||||
| 1417 | |||||
| 1418 | |||||
| 1419 | sub carp { | ||||
| 1420 | my $self = shift; | ||||
| 1421 | my $ctx = $self->ctx; | ||||
| 1422 | $ctx->alert(join "", @_); | ||||
| 1423 | $ctx->release; | ||||
| 1424 | } | ||||
| 1425 | |||||
| 1426 | sub croak { | ||||
| 1427 | my $self = shift; | ||||
| 1428 | my $ctx = $self->ctx; | ||||
| 1429 | $ctx->throw(join "", @_); | ||||
| 1430 | $ctx->release; | ||||
| 1431 | } | ||||
| 1432 | |||||
| 1433 | |||||
| 1434 | # spent 40µs (11+29) within Test::Builder::current_test which was called:
# once (11µs+29µs) by Test::Builder::done_testing at line 608 | ||||
| 1435 | 1 | 300ns | my( $self, $num ) = @_; | ||
| 1436 | |||||
| 1437 | 1 | 900ns | 1 | 21µs | my $ctx = $self->ctx; # spent 21µs making 1 call to Test::Builder::ctx |
| 1438 | 1 | 800ns | 1 | 500ns | my $hub = $ctx->hub; # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1439 | |||||
| 1440 | 1 | 300ns | if( defined $num ) { | ||
| 1441 | $hub->set_count($num); | ||||
| 1442 | |||||
| 1443 | unless ($self->{no_log_results}) { | ||||
| 1444 | # If the test counter is being pushed forward fill in the details. | ||||
| 1445 | my $test_results = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}; | ||||
| 1446 | if ($num > @$test_results) { | ||||
| 1447 | my $start = @$test_results ? @$test_results : 0; | ||||
| 1448 | for ($start .. $num - 1) { | ||||
| 1449 | $test_results->[$_] = { | ||||
| 1450 | 'ok' => 1, | ||||
| 1451 | actual_ok => undef, | ||||
| 1452 | reason => 'incrementing test number', | ||||
| 1453 | type => 'unknown', | ||||
| 1454 | name => undef | ||||
| 1455 | }; | ||||
| 1456 | } | ||||
| 1457 | } | ||||
| 1458 | # If backward, wipe history. Its their funeral. | ||||
| 1459 | elsif ($num < @$test_results) { | ||||
| 1460 | $#{$test_results} = $num - 1; | ||||
| 1461 | } | ||||
| 1462 | } | ||||
| 1463 | } | ||||
| 1464 | 1 | 6µs | 3 | 7µs | return release $ctx, $hub->count; # spent 6µs making 1 call to Test2::API::release
# spent 700ns making 1 call to Test2::API::Context::DESTROY
# spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1465 | } | ||||
| 1466 | |||||
| 1467 | |||||
| 1468 | sub is_passing { | ||||
| 1469 | my $self = shift; | ||||
| 1470 | |||||
| 1471 | my $ctx = $self->ctx; | ||||
| 1472 | my $hub = $ctx->hub; | ||||
| 1473 | |||||
| 1474 | if( @_ ) { | ||||
| 1475 | my ($bool) = @_; | ||||
| 1476 | $hub->set_failed(0) if $bool; | ||||
| 1477 | $hub->is_passing($bool); | ||||
| 1478 | } | ||||
| 1479 | |||||
| 1480 | return release $ctx, $hub->is_passing; | ||||
| 1481 | } | ||||
| 1482 | |||||
| 1483 | |||||
| 1484 | sub summary { | ||||
| 1485 | my($self) = shift; | ||||
| 1486 | |||||
| 1487 | return if $self->{no_log_results}; | ||||
| 1488 | |||||
| 1489 | my $ctx = $self->ctx; | ||||
| 1490 | my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}; | ||||
| 1491 | $ctx->release; | ||||
| 1492 | return map { $_ ? $_->{'ok'} : () } @$data; | ||||
| 1493 | } | ||||
| 1494 | |||||
| 1495 | |||||
| 1496 | sub details { | ||||
| 1497 | my $self = shift; | ||||
| 1498 | |||||
| 1499 | return if $self->{no_log_results}; | ||||
| 1500 | |||||
| 1501 | my $ctx = $self->ctx; | ||||
| 1502 | my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}; | ||||
| 1503 | $ctx->release; | ||||
| 1504 | return @$data; | ||||
| 1505 | } | ||||
| 1506 | |||||
| 1507 | |||||
| 1508 | sub find_TODO { | ||||
| 1509 | my( $self, $pack, $set, $new_value ) = @_; | ||||
| 1510 | |||||
| 1511 | my $ctx = $self->ctx; | ||||
| 1512 | |||||
| 1513 | $pack ||= $ctx->trace->package || $self->exported_to; | ||||
| 1514 | $ctx->release; | ||||
| 1515 | |||||
| 1516 | return unless $pack; | ||||
| 1517 | |||||
| 1518 | 2 | 27µs | 2 | 15µs | # spent 11µs (6+4) within Test::Builder::BEGIN@1518 which was called:
# once (6µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1518 # spent 11µs making 1 call to Test::Builder::BEGIN@1518
# spent 4µs making 1 call to strict::unimport |
| 1519 | 2 | 92µs | 2 | 31µs | # spent 19µs (7+12) within Test::Builder::BEGIN@1519 which was called:
# once (7µs+12µs) by Test::Builder::Module::BEGIN@5 at line 1519 # spent 19µs making 1 call to Test::Builder::BEGIN@1519
# spent 12µs making 1 call to warnings::unimport |
| 1520 | my $old_value = ${ $pack . '::TODO' }; | ||||
| 1521 | $set and ${ $pack . '::TODO' } = $new_value; | ||||
| 1522 | return $old_value; | ||||
| 1523 | } | ||||
| 1524 | |||||
| 1525 | sub todo { | ||||
| 1526 | my( $self, $pack ) = @_; | ||||
| 1527 | |||||
| 1528 | local $Level = $Level + 1; | ||||
| 1529 | my $ctx = $self->ctx; | ||||
| 1530 | $ctx->release; | ||||
| 1531 | |||||
| 1532 | my $meta = $ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}; | ||||
| 1533 | return $meta->[-1]->[1] if $meta && @$meta; | ||||
| 1534 | |||||
| 1535 | $pack ||= $ctx->trace->package; | ||||
| 1536 | |||||
| 1537 | return unless $pack; | ||||
| 1538 | |||||
| 1539 | 2 | 20µs | 2 | 13µs | # spent 9µs (5+4) within Test::Builder::BEGIN@1539 which was called:
# once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1539 # spent 9µs making 1 call to Test::Builder::BEGIN@1539
# spent 4µs making 1 call to strict::unimport |
| 1540 | 2 | 72µs | 2 | 25µs | # spent 14µs (4+11) within Test::Builder::BEGIN@1540 which was called:
# once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 1540 # spent 14µs making 1 call to Test::Builder::BEGIN@1540
# spent 11µs making 1 call to warnings::unimport |
| 1541 | return ${ $pack . '::TODO' }; | ||||
| 1542 | } | ||||
| 1543 | |||||
| 1544 | sub in_todo { | ||||
| 1545 | my $self = shift; | ||||
| 1546 | |||||
| 1547 | local $Level = $Level + 1; | ||||
| 1548 | my $ctx = $self->ctx; | ||||
| 1549 | $ctx->release; | ||||
| 1550 | |||||
| 1551 | my $meta = $ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}; | ||||
| 1552 | return 1 if $meta && @$meta; | ||||
| 1553 | |||||
| 1554 | my $pack = $ctx->trace->package || return 0; | ||||
| 1555 | |||||
| 1556 | 2 | 21µs | 2 | 12µs | # spent 9µs (6+3) within Test::Builder::BEGIN@1556 which was called:
# once (6µs+3µs) by Test::Builder::Module::BEGIN@5 at line 1556 # spent 9µs making 1 call to Test::Builder::BEGIN@1556
# spent 3µs making 1 call to strict::unimport |
| 1557 | 2 | 662µs | 2 | 24µs | # spent 13µs (3+10) within Test::Builder::BEGIN@1557 which was called:
# once (3µs+10µs) by Test::Builder::Module::BEGIN@5 at line 1557 # spent 13µs making 1 call to Test::Builder::BEGIN@1557
# spent 10µs making 1 call to warnings::unimport |
| 1558 | my $todo = ${ $pack . '::TODO' }; | ||||
| 1559 | |||||
| 1560 | return 0 unless defined $todo; | ||||
| 1561 | return 0 if "$todo" eq ''; | ||||
| 1562 | return 1; | ||||
| 1563 | } | ||||
| 1564 | |||||
| 1565 | sub todo_start { | ||||
| 1566 | my $self = shift; | ||||
| 1567 | my $message = @_ ? shift : ''; | ||||
| 1568 | |||||
| 1569 | my $ctx = $self->ctx; | ||||
| 1570 | |||||
| 1571 | my $hub = $ctx->hub; | ||||
| 1572 | my $filter = $hub->pre_filter(sub { | ||||
| 1573 | my ($active_hub, $e) = @_; | ||||
| 1574 | |||||
| 1575 | # Turn a diag into a todo diag | ||||
| 1576 | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag'; | ||||
| 1577 | |||||
| 1578 | # Set todo on ok's | ||||
| 1579 | if ($hub == $active_hub && $e->isa('Test2::Event::Ok')) { | ||||
| 1580 | $e->set_todo($message); | ||||
| 1581 | $e->set_effective_pass(1); | ||||
| 1582 | |||||
| 1583 | if (my $result = $e->get_meta(__PACKAGE__)) { | ||||
| 1584 | $result->{reason} ||= $message; | ||||
| 1585 | $result->{type} ||= 'todo'; | ||||
| 1586 | $result->{ok} = 1; | ||||
| 1587 | } | ||||
| 1588 | } | ||||
| 1589 | |||||
| 1590 | return $e; | ||||
| 1591 | }, inherit => 1); | ||||
| 1592 | |||||
| 1593 | push @{$ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}} => [$filter, $message]; | ||||
| 1594 | |||||
| 1595 | $ctx->release; | ||||
| 1596 | |||||
| 1597 | return; | ||||
| 1598 | } | ||||
| 1599 | |||||
| 1600 | sub todo_end { | ||||
| 1601 | my $self = shift; | ||||
| 1602 | |||||
| 1603 | my $ctx = $self->ctx; | ||||
| 1604 | |||||
| 1605 | my $set = pop @{$ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}}; | ||||
| 1606 | |||||
| 1607 | $ctx->throw('todo_end() called without todo_start()') unless $set; | ||||
| 1608 | |||||
| 1609 | $ctx->hub->pre_unfilter($set->[0]); | ||||
| 1610 | |||||
| 1611 | $ctx->release; | ||||
| 1612 | |||||
| 1613 | return; | ||||
| 1614 | } | ||||
| 1615 | |||||
| 1616 | |||||
| 1617 | sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms) | ||||
| 1618 | my( $self ) = @_; | ||||
| 1619 | |||||
| 1620 | my $ctx = $self->ctx; | ||||
| 1621 | |||||
| 1622 | my $trace = $ctx->trace; | ||||
| 1623 | $ctx->release; | ||||
| 1624 | return wantarray ? $trace->call : $trace->package; | ||||
| 1625 | } | ||||
| 1626 | |||||
| 1627 | |||||
| 1628 | sub _try { | ||||
| 1629 | my( $self, $code, %opts ) = @_; | ||||
| 1630 | |||||
| 1631 | my $error; | ||||
| 1632 | my $return; | ||||
| 1633 | { | ||||
| 1634 | local $!; # eval can mess up $! | ||||
| 1635 | local $@; # don't set $@ in the test | ||||
| 1636 | local $SIG{__DIE__}; # don't trip an outside DIE handler. | ||||
| 1637 | $return = eval { $code->() }; | ||||
| 1638 | $error = $@; | ||||
| 1639 | } | ||||
| 1640 | |||||
| 1641 | die $error if $error and $opts{die_on_fail}; | ||||
| 1642 | |||||
| 1643 | return wantarray ? ( $return, $error ) : $return; | ||||
| 1644 | } | ||||
| 1645 | |||||
| 1646 | # spent 43µs (29+14) within Test::Builder::_ending which was called:
# once (29µs+14µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:156] at line 156 | ||||
| 1647 | 1 | 200ns | my $self = shift; | ||
| 1648 | 1 | 500ns | my ($ctx, $real_exit_code, $new) = @_; | ||
| 1649 | |||||
| 1650 | 1 | 300ns | unless ($ctx) { | ||
| 1651 | my $octx = $self->ctx; | ||||
| 1652 | $ctx = $octx->snapshot; | ||||
| 1653 | $octx->release; | ||||
| 1654 | } | ||||
| 1655 | |||||
| 1656 | 1 | 1µs | 2 | 900ns | return if $ctx->hub->no_ending; # spent 900ns making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 450ns/call |
| 1657 | 1 | 3µs | 2 | 4µs | return if $ctx->hub->meta(__PACKAGE__, {})->{Ending}++; # spent 4µs making 1 call to Test2::Util::ExternalMeta::meta
# spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1658 | |||||
| 1659 | # Don't bother with an ending if this is a forked copy. Only the parent | ||||
| 1660 | # should do the ending. | ||||
| 1661 | 1 | 1µs | return unless $self->{Original_Pid} == $$; | ||
| 1662 | |||||
| 1663 | 1 | 800ns | 1 | 300ns | my $hub = $ctx->hub; # spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1664 | 1 | 2µs | 1 | 1µs | return if $hub->bailed_out; # spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1665 | |||||
| 1666 | 1 | 1µs | 1 | 900ns | my $plan = $hub->plan; # spent 900ns making 1 call to Test2::Hub::plan |
| 1667 | 1 | 900ns | 1 | 500ns | my $count = $hub->count; # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1668 | 1 | 1µs | 1 | 600ns | my $failed = $hub->failed; # spent 600ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] |
| 1669 | 1 | 800ns | 1 | 5µs | my $passed = $hub->is_passing; # spent 5µs making 1 call to Test2::Hub::is_passing |
| 1670 | 1 | 400ns | return unless $plan || $count || $failed; | ||
| 1671 | |||||
| 1672 | # Ran tests but never declared a plan or hit done_testing | ||||
| 1673 | 1 | 900ns | 1 | 500ns | if( !defined($hub->plan) and $hub->count ) { # spent 500ns making 1 call to Test2::Hub::plan |
| 1674 | $self->diag("Tests were run but no plan was declared and done_testing() was not seen."); | ||||
| 1675 | |||||
| 1676 | if($real_exit_code) { | ||||
| 1677 | $self->diag(<<"FAIL"); | ||||
| 1678 | Looks like your test exited with $real_exit_code just after $count. | ||||
| 1679 | FAIL | ||||
| 1680 | $$new ||= $real_exit_code; | ||||
| 1681 | return; | ||||
| 1682 | } | ||||
| 1683 | |||||
| 1684 | # But if the tests ran, handle exit code. | ||||
| 1685 | if($failed > 0) { | ||||
| 1686 | my $exit_code = $failed <= 254 ? $failed : 254; | ||||
| 1687 | $$new ||= $exit_code; | ||||
| 1688 | return; | ||||
| 1689 | } | ||||
| 1690 | |||||
| 1691 | $$new ||= 254; | ||||
| 1692 | return; | ||||
| 1693 | } | ||||
| 1694 | |||||
| 1695 | 1 | 200ns | if ($real_exit_code && !$count) { | ||
| 1696 | $self->diag("Looks like your test exited with $real_exit_code before it could output anything."); | ||||
| 1697 | $$new ||= $real_exit_code; | ||||
| 1698 | return; | ||||
| 1699 | } | ||||
| 1700 | |||||
| 1701 | 1 | 800ns | return if $plan && "$plan" eq 'SKIP'; | ||
| 1702 | |||||
| 1703 | 1 | 200ns | if (!$count) { | ||
| 1704 | $self->diag('No tests run!'); | ||||
| 1705 | $$new ||= 255; | ||||
| 1706 | return; | ||||
| 1707 | } | ||||
| 1708 | |||||
| 1709 | 1 | 200ns | if ($real_exit_code) { | ||
| 1710 | $self->diag(<<"FAIL"); | ||||
| 1711 | Looks like your test exited with $real_exit_code just after $count. | ||||
| 1712 | FAIL | ||||
| 1713 | $$new ||= $real_exit_code; | ||||
| 1714 | return; | ||||
| 1715 | } | ||||
| 1716 | |||||
| 1717 | 1 | 400ns | if ($plan eq 'NO PLAN') { | ||
| 1718 | $ctx->plan( $count ); | ||||
| 1719 | $plan = $hub->plan; | ||||
| 1720 | } | ||||
| 1721 | |||||
| 1722 | # Figure out if we passed or failed and print helpful messages. | ||||
| 1723 | 1 | 300ns | my $num_extra = $count - $plan; | ||
| 1724 | |||||
| 1725 | 1 | 300ns | if ($num_extra != 0) { | ||
| 1726 | my $s = $plan == 1 ? '' : 's'; | ||||
| 1727 | $self->diag(<<"FAIL"); | ||||
| 1728 | Looks like you planned $plan test$s but ran $count. | ||||
| 1729 | FAIL | ||||
| 1730 | } | ||||
| 1731 | |||||
| 1732 | 1 | 300ns | if ($failed) { | ||
| 1733 | my $s = $failed == 1 ? '' : 's'; | ||||
| 1734 | |||||
| 1735 | my $qualifier = $num_extra == 0 ? '' : ' run'; | ||||
| 1736 | |||||
| 1737 | $self->diag(<<"FAIL"); | ||||
| 1738 | Looks like you failed $failed test$s of $count$qualifier. | ||||
| 1739 | FAIL | ||||
| 1740 | } | ||||
| 1741 | |||||
| 1742 | 1 | 400ns | if (!$passed && !$failed && $count && !$num_extra) { | ||
| 1743 | $ctx->diag(<<"FAIL"); | ||||
| 1744 | All assertions passed, but errors were encountered. | ||||
| 1745 | FAIL | ||||
| 1746 | } | ||||
| 1747 | |||||
| 1748 | 1 | 200ns | my $exit_code = 0; | ||
| 1749 | 1 | 800ns | if ($failed) { | ||
| 1750 | $exit_code = $failed <= 254 ? $failed : 254; | ||||
| 1751 | } | ||||
| 1752 | elsif ($num_extra != 0) { | ||||
| 1753 | $exit_code = 255; | ||||
| 1754 | } | ||||
| 1755 | elsif (!$passed) { | ||||
| 1756 | $exit_code = 255; | ||||
| 1757 | } | ||||
| 1758 | |||||
| 1759 | 1 | 800ns | $$new ||= $exit_code; | ||
| 1760 | 1 | 2µs | return; | ||
| 1761 | } | ||||
| 1762 | |||||
| 1763 | # Some things used this even though it was private... I am looking at you | ||||
| 1764 | # Test::Builder::Prefix... | ||||
| 1765 | sub _print_comment { | ||||
| 1766 | my( $self, $fh, @msgs ) = @_; | ||||
| 1767 | |||||
| 1768 | return if $self->no_diag; | ||||
| 1769 | return unless @msgs; | ||||
| 1770 | |||||
| 1771 | # Prevent printing headers when compiling (i.e. -c) | ||||
| 1772 | return if $^C; | ||||
| 1773 | |||||
| 1774 | # Smash args together like print does. | ||||
| 1775 | # Convert undef to 'undef' so its readable. | ||||
| 1776 | my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; | ||||
| 1777 | |||||
| 1778 | # Escape the beginning, _print will take care of the rest. | ||||
| 1779 | $msg =~ s/^/# /; | ||||
| 1780 | |||||
| 1781 | local( $\, $", $, ) = ( undef, ' ', '' ); | ||||
| 1782 | print $fh $msg; | ||||
| 1783 | |||||
| 1784 | return 0; | ||||
| 1785 | } | ||||
| 1786 | |||||
| 1787 | # This is used by Test::SharedFork to turn on IPC after the fact. Not | ||||
| 1788 | # documenting because I do not want it used. The method name is borrowed from | ||||
| 1789 | # Test::Builder 2 | ||||
| 1790 | # Once Test2 stuff goes stable this method will be removed and Test::SharedFork | ||||
| 1791 | # will be made smarter. | ||||
| 1792 | sub coordinate_forks { | ||||
| 1793 | my $self = shift; | ||||
| 1794 | |||||
| 1795 | { | ||||
| 1796 | local ($@, $!); | ||||
| 1797 | require Test2::IPC; | ||||
| 1798 | } | ||||
| 1799 | Test2::IPC->import; | ||||
| 1800 | Test2::API::test2_ipc_enable_polling(); | ||||
| 1801 | Test2::API::test2_load(); | ||||
| 1802 | my $ipc = Test2::IPC::apply_ipc($self->{Stack}); | ||||
| 1803 | $ipc->set_no_fatal(1); | ||||
| 1804 | Test2::API::test2_no_wait(1); | ||||
| 1805 | } | ||||
| 1806 | |||||
| 1807 | sub no_log_results { $_[0]->{no_log_results} = 1 } | ||||
| 1808 | |||||
| 1809 | 1 | 6µs | 1; | ||
| 1810 | |||||
| 1811 | __END__ | ||||
sub Test::Builder::__ANON__; # xsub |