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

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/Util.pm
StatementsExecuted 109 statements in 1.84ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.52ms7.23msTest2::Util::::BEGIN@7Test2::Util::BEGIN@7
111439µs495µsTest2::Util::::BEGIN@8Test2::Util::BEGIN@8
111195µs202µsTest2::Util::::BEGIN@11Test2::Util::BEGIN@11
44260µs129µsTest2::Util::::clone_ioTest2::Util::clone_io
83319µs19µsTest2::Util::::gen_uidTest2::Util::gen_uid
11117µs1.73msTest2::Util::::BEGIN@171Test2::Util::BEGIN@171
11110µs12µsTest2::Util::::BEGIN@2Test2::Util::BEGIN@2
1118µs16µsTest2::Util::::BEGIN@71Test2::Util::BEGIN@71
1117µs7µsTest2::Util::::BEGIN@40Test2::Util::BEGIN@40
1116µs6µsTest2::Util::::BEGIN@206Test2::Util::BEGIN@206
1116µs8µsTest2::Util::::_can_threadTest2::Util::_can_thread
1115µs17µsTest2::Util::::BEGIN@113Test2::Util::BEGIN@113
1115µs20µsTest2::Util::::BEGIN@72Test2::Util::BEGIN@72
1115µs1.71msTest2::Util::::_check_for_sig_sysTest2::Util::_check_for_sig_sys
1114µs31µsTest2::Util::::BEGIN@9Test2::Util::BEGIN@9
1114µs16µsTest2::Util::::BEGIN@80Test2::Util::BEGIN@80
1114µs16µsTest2::Util::::BEGIN@89Test2::Util::BEGIN@89
1114µs4µsTest2::Util::::BEGIN@123Test2::Util::BEGIN@123
1113µs3µsTest2::Util::::BEGIN@132Test2::Util::BEGIN@132
1113µs3µsTest2::Util::::BEGIN@42Test2::Util::BEGIN@42
1113µs18µsTest2::Util::::BEGIN@3Test2::Util::BEGIN@3
111800ns800nsTest2::Util::::__ANON__Test2::Util::__ANON__ (xsub)
0000s0sTest2::Util::::CAN_FORKTest2::Util::CAN_FORK
0000s0sTest2::Util::::CAN_REALLY_FORKTest2::Util::CAN_REALLY_FORK
0000s0sTest2::Util::::__ANON__[:138]Test2::Util::__ANON__[:138]
0000s0sTest2::Util::::__ANON__[:142]Test2::Util::__ANON__[:142]
0000s0sTest2::Util::::__ANON__[:143]Test2::Util::__ANON__[:143]
0000s0sTest2::Util::::__ANON__[:222]Test2::Util::__ANON__[:222]
0000s0sTest2::Util::::__ANON__[:235]Test2::Util::__ANON__[:235]
0000s0sTest2::Util::::__ANON__[:242]Test2::Util::__ANON__[:242]
0000s0sTest2::Util::::__ANON__[:247]Test2::Util::__ANON__[:247]
0000s0sTest2::Util::::_can_forkTest2::Util::_can_fork
0000s0sTest2::Util::::_local_tryTest2::Util::_local_try
0000s0sTest2::Util::::_manual_tryTest2::Util::_manual_try
0000s0sTest2::Util::::pkg_to_fileTest2::Util::pkg_to_file
0000s0sTest2::Util::::try_sig_maskTest2::Util::try_sig_mask
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test2::Util;
2220µs214µs
# spent 12µs (10+2) within Test2::Util::BEGIN@2 which was called: # once (10µs+2µs) by Test::Builder::BEGIN@17 at line 2
use strict;
# spent 12µs making 1 call to Test2::Util::BEGIN@2 # spent 2µs making 1 call to strict::import
3222µs232µs
# spent 18µs (3+15) within Test2::Util::BEGIN@3 which was called: # once (3µs+15µs) by Test::Builder::BEGIN@17 at line 3
use warnings;
# spent 18µs making 1 call to Test2::Util::BEGIN@3 # spent 15µs making 1 call to warnings::import
4
51300nsour $VERSION = '1.302198';
6
7295µs17.23ms
# spent 7.23ms (2.52+4.71) within Test2::Util::BEGIN@7 which was called: # once (2.52ms+4.71ms) by Test::Builder::BEGIN@17 at line 7
use POSIX();
# spent 7.23ms making 1 call to Test2::Util::BEGIN@7
8285µs2502µs
# spent 495µs (439+57) within Test2::Util::BEGIN@8 which was called: # once (439µs+57µs) by Test::Builder::BEGIN@17 at line 8
use Config qw/%Config/;
# spent 495µs making 1 call to Test2::Util::BEGIN@8 # spent 7µs making 1 call to Config::import
9253µs258µs
# spent 31µs (4+27) within Test2::Util::BEGIN@9 which was called: # once (4µs+27µs) by Test::Builder::BEGIN@17 at line 9
use Carp qw/croak/;
# spent 31µs making 1 call to Test2::Util::BEGIN@9 # spent 27µs making 1 call to Exporter::import
10
11
# spent 202µs (195+7) within Test2::Util::BEGIN@11 which was called: # once (195µs+7µs) by Test::Builder::BEGIN@17 at line 14
BEGIN {
1212µs local ($@, $!, $SIG{__DIE__});
133196µs17µs *HAVE_PERLIO = eval { require PerlIO; PerlIO->VERSION(1.02); } ? sub() { 1 } : sub() { 0 };
# spent 7µs making 1 call to UNIVERSAL::VERSION
14144µs1202µs}
# spent 202µs making 1 call to Test2::Util::BEGIN@11
15
1611µsour @EXPORT_OK = qw{
17 try
18
19 pkg_to_file
20
21 get_tid USE_THREADS
22 CAN_THREAD
23 CAN_REALLY_FORK
24 CAN_FORK
25
26 CAN_SIGSYS
27
28 IS_WIN32
29
30 ipc_separator
31
32 gen_uid
33
34 do_rename do_unlink
35
36 try_sig_mask
37
38 clone_io
39};
40240µs17µs
# spent 7µs within Test2::Util::BEGIN@40 which was called: # once (7µs+0s) by Test::Builder::BEGIN@17 at line 40
BEGIN { require Exporter; our @ISA = qw(Exporter) }
# spent 7µs making 1 call to Test2::Util::BEGIN@40
41
42
# spent 3µs within Test2::Util::BEGIN@42 which was called: # once (3µs+0s) by Test::Builder::BEGIN@17 at line 44
BEGIN {
4314µs *IS_WIN32 = ($^O eq 'MSWin32') ? sub() { 1 } : sub() { 0 };
441154µs13µs}
# spent 3µs making 1 call to Test2::Util::BEGIN@42
45
46
# spent 8µs (6+2) within Test2::Util::_can_thread which was called: # once (6µs+2µs) by Test2::Util::BEGIN@71 at line 73
sub _can_thread {
471200ns return 0 unless $] >= 5.008001;
4819µs12µs return 0 unless $Config{'useithreads'};
# spent 2µs making 1 call to Config::FETCH
49
50 # Threads are broken on perl 5.10.0 built with gcc 4.8+
51 if ($] == 5.010000 && $Config{'ccname'} eq 'gcc' && $Config{'gccversion'}) {
52 return 0 unless $Config{'gccversion'} =~ m/^(\d+)\.(\d+)/;
53 my @parts = split /[\.\s]+/, $Config{'gccversion'};
54 return 0 if $parts[0] > 4 || ($parts[0] == 4 && $parts[1] >= 8);
55 }
56
57 # Change to a version check if this ever changes
58 return 0 if $INC{'Devel/Cover.pm'};
59 return 1;
60}
61
62sub _can_fork {
63 return 1 if $Config{d_fork};
64 return 0 unless IS_WIN32 || $^O eq 'NetWare';
65 return 0 unless $Config{useithreads};
66 return 0 unless $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/;
67
68 return _can_thread();
69}
70
71
# spent 16µs (8+8) within Test2::Util::BEGIN@71 which was called: # once (8µs+8µs) by Test::Builder::BEGIN@17 at line 74
BEGIN {
72234µs235µs
# spent 20µs (5+15) within Test2::Util::BEGIN@72 which was called: # once (5µs+15µs) by Test::Builder::BEGIN@17 at line 72
no warnings 'once';
# spent 20µs making 1 call to Test2::Util::BEGIN@72 # spent 15µs making 1 call to warnings::unimport
7312µs18µs *CAN_THREAD = _can_thread() ? sub() { 1 } : sub() { 0 };
# spent 8µs making 1 call to Test2::Util::_can_thread
74133µs116µs}
# spent 16µs making 1 call to Test2::Util::BEGIN@71
751200nsmy $can_fork;
76sub CAN_FORK () {
77 return $can_fork
78 if defined $can_fork;
79 $can_fork = !!_can_fork();
80258µs228µs
# spent 16µs (4+12) within Test2::Util::BEGIN@80 which was called: # once (4µs+12µs) by Test::Builder::BEGIN@17 at line 80
no warnings 'redefine';
# spent 16µs making 1 call to Test2::Util::BEGIN@80 # spent 12µs making 1 call to warnings::unimport
81 *CAN_FORK = $can_fork ? sub() { 1 } : sub() { 0 };
82 $can_fork;
83}
84my $can_really_fork;
85sub CAN_REALLY_FORK () {
86 return $can_really_fork
87 if defined $can_really_fork;
88 $can_really_fork = !!$Config{d_fork};
892112µs227µs
# spent 16µs (4+12) within Test2::Util::BEGIN@89 which was called: # once (4µs+12µs) by Test::Builder::BEGIN@17 at line 89
no warnings 'redefine';
# spent 16µs making 1 call to Test2::Util::BEGIN@89 # spent 12µs making 1 call to warnings::unimport
90 *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 };
91 $can_really_fork;
92}
93
94sub _manual_try(&;@) {
95 my $code = shift;
96 my $args = \@_;
97 my $err;
98
99 my $die = delete $SIG{__DIE__};
100
101 eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";
102
103 $die ? $SIG{__DIE__} = $die : delete $SIG{__DIE__};
104
105 return (!defined($err), $err);
106}
107
108sub _local_try(&;@) {
109 my $code = shift;
110 my $args = \@_;
111 my $err;
112
1132103µs229µs
# spent 17µs (5+12) within Test2::Util::BEGIN@113 which was called: # once (5µs+12µs) by Test::Builder::BEGIN@17 at line 113
no warnings;
# spent 17µs making 1 call to Test2::Util::BEGIN@113 # spent 12µs making 1 call to warnings::unimport
114 local $SIG{__DIE__};
115 eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";
116
117 return (!defined($err), $err);
118}
119
120# Older versions of perl have a nasty bug on win32 when localizing a variable
121# before forking or starting a new thread. So for those systems we use the
122# non-local form. When possible though we use the faster 'local' form.
123
# spent 4µs within Test2::Util::BEGIN@123 which was called: # once (4µs+0s) by Test::Builder::BEGIN@17 at line 130
BEGIN {
12413µs if (IS_WIN32 && $] < 5.020002) {
125 *try = \&_manual_try;
126 }
127 else {
12811µs *try = \&_local_try;
129 }
130193µs14µs}
# spent 4µs making 1 call to Test2::Util::BEGIN@123
131
132
# spent 3µs within Test2::Util::BEGIN@132 which was called: # once (3µs+0s) by Test::Builder::BEGIN@17 at line 151
BEGIN {
13312µs if (CAN_THREAD) {
134 if ($INC{'threads.pm'}) {
135 # Threads are already loaded, so we do not need to check if they
136 # are loaded each time
137 *USE_THREADS = sub() { 1 };
138 *get_tid = sub() { threads->tid() };
139 }
140 else {
141 # :-( Need to check each time to see if they have been loaded.
142 *USE_THREADS = sub() { $INC{'threads.pm'} ? 1 : 0 };
143 *get_tid = sub() { $INC{'threads.pm'} ? threads->tid() : 0 };
144 }
145 }
146 else {
147 # No threads, not now, not ever!
1481600ns *USE_THREADS = sub() { 0 };
1491200ns *get_tid = sub() { 0 };
150 }
1511166µs13µs}
# spent 3µs making 1 call to Test2::Util::BEGIN@132
152
153sub pkg_to_file {
154 my $pkg = shift;
155 my $file = $pkg;
156 $file =~ s{(::|')}{/}g;
157 $file .= '.pm';
158 return $file;
159}
160
161sub ipc_separator() { "~" }
162
1631300nsmy $UID = 1;
164826µs
# spent 19µs within Test2::Util::gen_uid which was called 8 times, avg 2µs/call: # 4 times (10µs+0s) by Test2::API::context at line 485 of Test2/API.pm, avg 2µs/call # 3 times (6µs+0s) by Test2::Event::eid at line 123 of Test2/Event.pm, avg 2µs/call # once (3µs+0s) by Test2::Hub::init at line 46 of Test2/Hub.pm
sub gen_uid() { join ipc_separator() => ($$, get_tid(), time, $UID++) }
165
166
# spent 1.71ms (5µs+1.71) within Test2::Util::_check_for_sig_sys which was called: # once (5µs+1.71ms) by Test2::Util::BEGIN@171 at line 172
sub _check_for_sig_sys {
16712µs11.71ms my $sig_list = shift;
# spent 1.71ms making 1 call to Config::FETCH
16814µs11µs return $sig_list =~ m/\bSYS\b/;
# spent 1µs making 1 call to CORE::match
169}
170
171
# spent 1.73ms (17µs+1.71) within Test2::Util::BEGIN@171 which was called: # once (17µs+1.71ms) by Test::Builder::BEGIN@17 at line 178
BEGIN {
17214µs11.71ms if (_check_for_sig_sys($Config{sig_name})) {
# spent 1.71ms making 1 call to Test2::Util::_check_for_sig_sys
173 *CAN_SIGSYS = sub() { 1 };
174 }
175 else {
176 *CAN_SIGSYS = sub() { 0 };
177 }
1781248µs11.73ms}
# spent 1.73ms making 1 call to Test2::Util::BEGIN@171
179
18011µsmy %PERLIO_SKIP = (
181 unix => 1,
182 via => 1,
183);
184
185
# spent 129µs (60+69) within Test2::Util::clone_io which was called 4 times, avg 32µs/call: # once (22µs+26µs) by Test::Builder::BEGIN@18 at line 186 of Test2/API.pm # once (16µs+20µs) by Test2::Formatter::TAP::_open_handles at line 57 of Test2/Formatter/TAP.pm # once (10µs+12µs) by Test2::Formatter::TAP::_open_handles at line 58 of Test2/Formatter/TAP.pm # once (11µs+11µs) by Test::Builder::BEGIN@18 at line 187 of Test2/API.pm
sub clone_io {
18641µs my ($fh) = @_;
18784µs my $fileno = eval { fileno($fh) };
188
18943µs return $fh if !defined($fileno) || !length($fileno) || $fileno < 0;
190
191459µs447µs open(my $out, '>&' . $fileno) or die "Can't dup fileno $fileno: $!";
# spent 47µs making 4 calls to CORE::open, avg 12µs/call
192
1934600ns my %seen;
194419µs47µs my @layers = HAVE_PERLIO ? grep { !$PERLIO_SKIP{$_} and !$seen{$_}++ } PerlIO::get_layers($fh) : ();
# spent 7µs making 4 calls to PerlIO::get_layers, avg 2µs/call
195418µs412µs binmode($out, join(":", "", "raw", @layers));
# spent 12µs making 4 calls to CORE::binmode, avg 3µs/call
196
19747µs43µs my $old = select $fh;
# spent 3µs making 4 calls to CORE::select, avg 650ns/call
19842µs my $af = $|;
19944µs4900ns select $out;
# spent 900ns making 4 calls to CORE::select, avg 225ns/call
20041µs $| = $af;
20144µs4500ns select $old;
# spent 500ns making 4 calls to CORE::select, avg 125ns/call
202
20348µs return $out;
204}
205
206
# spent 6µs within Test2::Util::BEGIN@206 which was called: # once (6µs+0s) by Test::Builder::BEGIN@17 at line 249
BEGIN {
20713µs if (IS_WIN32) {
208 my $max_tries = 5;
209
210 *do_rename = sub {
211 my ($from, $to) = @_;
212
213 my $err;
214 for (1 .. $max_tries) {
215 return (1) if rename($from, $to);
216 $err = "$!";
217 last if $_ == $max_tries;
218 sleep 1;
219 }
220
221 return (0, $err);
222 };
223 *do_unlink = sub {
224 my ($file) = @_;
225
226 my $err;
227 for (1 .. $max_tries) {
228 return (1) if unlink($file);
229 $err = "$!";
230 last if $_ == $max_tries;
231 sleep 1;
232 }
233
234 return (0, "$!");
235 };
236 }
237 else {
238 *do_rename = sub {
239 my ($from, $to) = @_;
240 return (1) if rename($from, $to);
241 return (0, "$!");
24213µs };
243 *do_unlink = sub {
244 my ($file) = @_;
245 return (1) if unlink($file);
246 return (0, "$!");
2471800ns };
248 }
249179µs16µs}
# spent 6µs making 1 call to Test2::Util::BEGIN@206
250
251sub try_sig_mask(&) {
252 my $code = shift;
253
254 my ($old, $blocked);
255 unless(IS_WIN32) {
256 my $to_block = POSIX::SigSet->new(
257 POSIX::SIGINT(),
258 POSIX::SIGALRM(),
259 POSIX::SIGHUP(),
260 POSIX::SIGTERM(),
261 POSIX::SIGUSR1(),
262 POSIX::SIGUSR2(),
263 );
264 $old = POSIX::SigSet->new;
265 $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old);
266 # Silently go on if we failed to log signals, not much we can do.
267 }
268
269 my ($ok, $err) = &try($code);
270
271 # If our block was successful we want to restore the old mask.
272 POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
273
274 return ($ok, $err);
275}
276
27714µs1;
278
279__END__
 
# spent 800ns within Test2::Util::__ANON__ which was called: # once (800ns+0s) by Test2::API::test2_set_is_end at line 36 of Test2/API.pm
sub Test2::Util::__ANON__; # xsub