Filename | /home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/Fatal.pm |
Statements | Executed 455 statements in 5.60ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 1.46ms | 2.21ms | _make_fatal | Fatal::
1 | 1 | 1 | 1.18ms | 2.68ms | BEGIN@7 | Fatal::
5 | 1 | 1 | 138µs | 138µs | _one_invocation | Fatal::
2 | 1 | 1 | 122µs | 265µs | _write_invocation | Fatal::
2 | 1 | 1 | 113µs | 152µs | fill_protos | Fatal::
1 | 1 | 1 | 106µs | 2.33ms | import | Fatal::
2 | 1 | 1 | 81µs | 81µs | _install_subs | Fatal::
21 | 6 | 1 | 37µs | 37µs | CORE:subst (opcode) | Fatal::
18 | 6 | 1 | 30µs | 30µs | CORE:match (opcode) | Fatal::
1 | 1 | 1 | 30µs | 30µs | BEGIN@3 | Fatal::
1 | 1 | 1 | 19µs | 77µs | BEGIN@27 | Fatal::
1 | 1 | 1 | 15µs | 19µs | BEGIN@385 | Fatal::
1 | 1 | 1 | 14µs | 90µs | BEGIN@10 | Fatal::
1 | 1 | 1 | 13µs | 18µs | BEGIN@5 | Fatal::
1 | 1 | 1 | 13µs | 84µs | BEGIN@4 | Fatal::
1 | 1 | 1 | 12µs | 36µs | BEGIN@1096 | Fatal::
1 | 1 | 1 | 12µs | 38µs | BEGIN@364 | Fatal::
1 | 1 | 1 | 12µs | 34µs | BEGIN@8 | Fatal::
1 | 1 | 1 | 11µs | 70µs | BEGIN@13 | Fatal::
1 | 1 | 1 | 11µs | 67µs | BEGIN@40 | Fatal::
1 | 1 | 1 | 11µs | 16µs | BEGIN@369 | Fatal::
1 | 1 | 1 | 11µs | 20µs | BEGIN@6 | Fatal::
1 | 1 | 1 | 10µs | 68µs | BEGIN@25 | Fatal::
1 | 1 | 1 | 10µs | 65µs | BEGIN@16 | Fatal::
1 | 1 | 1 | 10µs | 66µs | BEGIN@17 | Fatal::
1 | 1 | 1 | 10µs | 65µs | BEGIN@14 | Fatal::
1 | 1 | 1 | 10µs | 65µs | BEGIN@12 | Fatal::
1 | 1 | 1 | 10µs | 76µs | BEGIN@21 | Fatal::
1 | 1 | 1 | 10µs | 65µs | BEGIN@18 | Fatal::
1 | 1 | 1 | 10µs | 71µs | BEGIN@33 | Fatal::
1 | 1 | 1 | 10µs | 66µs | BEGIN@19 | Fatal::
1 | 1 | 1 | 10µs | 69µs | BEGIN@23 | Fatal::
1 | 1 | 1 | 9µs | 67µs | BEGIN@29 | Fatal::
1 | 1 | 1 | 9µs | 65µs | BEGIN@35 | Fatal::
1 | 1 | 1 | 9µs | 67µs | BEGIN@22 | Fatal::
1 | 1 | 1 | 9µs | 66µs | BEGIN@31 | Fatal::
1 | 1 | 1 | 9µs | 65µs | BEGIN@20 | Fatal::
1 | 1 | 1 | 9µs | 9µs | new | autodie::Scope::Guard::
0 | 0 | 0 | 0s | 0s | __ANON__[:324] | Fatal::
0 | 0 | 0 | 0s | 0s | _autocroak | Fatal::
0 | 0 | 0 | 0s | 0s | _expand_tag | Fatal::
0 | 0 | 0 | 0s | 0s | exception_class | Fatal::
0 | 0 | 0 | 0s | 0s | one_invocation | Fatal::
0 | 0 | 0 | 0s | 0s | throw | Fatal::
0 | 0 | 0 | 0s | 0s | unimport | Fatal::
0 | 0 | 0 | 0s | 0s | write_invocation | Fatal::
0 | 0 | 0 | 0s | 0s | DESTROY | autodie::Scope::Guard::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Fatal; | ||||
2 | |||||
3 | 2 | 35µs | 1 | 30µs | # spent 30µs within Fatal::BEGIN@3 which was called:
# once (30µs+0s) by autodie::BEGIN@6 at line 3 # spent 30µs making 1 call to Fatal::BEGIN@3 |
4 | 2 | 30µs | 2 | 155µs | # spent 84µs (13+71) within Fatal::BEGIN@4 which was called:
# once (13µs+71µs) by autodie::BEGIN@6 at line 4 # spent 84µs making 1 call to Fatal::BEGIN@4
# spent 71µs making 1 call to Exporter::import |
5 | 2 | 24µs | 2 | 23µs | # spent 18µs (13+5) within Fatal::BEGIN@5 which was called:
# once (13µs+5µs) by autodie::BEGIN@6 at line 5 # spent 18µs making 1 call to Fatal::BEGIN@5
# spent 5µs making 1 call to strict::import |
6 | 2 | 23µs | 2 | 29µs | # spent 20µs (11+9) within Fatal::BEGIN@6 which was called:
# once (11µs+9µs) by autodie::BEGIN@6 at line 6 # spent 20µs making 1 call to Fatal::BEGIN@6
# spent 9µs making 1 call to warnings::import |
7 | 2 | 158µs | 1 | 2.68ms | # spent 2.68ms (1.18+1.50) within Fatal::BEGIN@7 which was called:
# once (1.18ms+1.50ms) by autodie::BEGIN@6 at line 7 # spent 2.68ms making 1 call to Fatal::BEGIN@7 |
8 | 2 | 32µs | 2 | 56µs | # spent 34µs (12+22) within Fatal::BEGIN@8 which was called:
# once (12µs+22µs) by autodie::BEGIN@6 at line 8 # spent 34µs making 1 call to Fatal::BEGIN@8
# spent 22µs making 1 call to Config::import |
9 | |||||
10 | 2 | 32µs | 2 | 166µs | # spent 90µs (14+76) within Fatal::BEGIN@10 which was called:
# once (14µs+76µs) by autodie::BEGIN@6 at line 10 # spent 90µs making 1 call to Fatal::BEGIN@10
# spent 76µs making 1 call to constant::import |
11 | |||||
12 | 2 | 29µs | 2 | 120µs | # spent 65µs (10+55) within Fatal::BEGIN@12 which was called:
# once (10µs+55µs) by autodie::BEGIN@6 at line 12 # spent 65µs making 1 call to Fatal::BEGIN@12
# spent 55µs making 1 call to constant::import |
13 | 2 | 28µs | 2 | 128µs | # spent 70µs (11+58) within Fatal::BEGIN@13 which was called:
# once (11µs+58µs) by autodie::BEGIN@6 at line 13 # spent 70µs making 1 call to Fatal::BEGIN@13
# spent 58µs making 1 call to constant::import |
14 | 2 | 28µs | 2 | 120µs | # spent 65µs (10+55) within Fatal::BEGIN@14 which was called:
# once (10µs+55µs) by autodie::BEGIN@6 at line 14 # spent 65µs making 1 call to Fatal::BEGIN@14
# spent 55µs making 1 call to constant::import |
15 | |||||
16 | 2 | 40µs | 2 | 119µs | # spent 65µs (10+54) within Fatal::BEGIN@16 which was called:
# once (10µs+54µs) by autodie::BEGIN@6 at line 16 # spent 65µs making 1 call to Fatal::BEGIN@16
# spent 54µs making 1 call to constant::import |
17 | 2 | 33µs | 2 | 123µs | # spent 66µs (10+56) within Fatal::BEGIN@17 which was called:
# once (10µs+56µs) by autodie::BEGIN@6 at line 17 # spent 66µs making 1 call to Fatal::BEGIN@17
# spent 56µs making 1 call to constant::import |
18 | 2 | 33µs | 2 | 121µs | # spent 65µs (10+56) within Fatal::BEGIN@18 which was called:
# once (10µs+56µs) by autodie::BEGIN@6 at line 18 # spent 65µs making 1 call to Fatal::BEGIN@18
# spent 56µs making 1 call to constant::import |
19 | 2 | 26µs | 2 | 122µs | # spent 66µs (10+56) within Fatal::BEGIN@19 which was called:
# once (10µs+56µs) by autodie::BEGIN@6 at line 19 # spent 66µs making 1 call to Fatal::BEGIN@19
# spent 56µs making 1 call to constant::import |
20 | 2 | 26µs | 2 | 121µs | # spent 65µs (9+56) within Fatal::BEGIN@20 which was called:
# once (9µs+56µs) by autodie::BEGIN@6 at line 20 # spent 65µs making 1 call to Fatal::BEGIN@20
# spent 56µs making 1 call to constant::import |
21 | 2 | 32µs | 2 | 142µs | # spent 76µs (10+66) within Fatal::BEGIN@21 which was called:
# once (10µs+66µs) by autodie::BEGIN@6 at line 21 # spent 76µs making 1 call to Fatal::BEGIN@21
# spent 66µs making 1 call to constant::import |
22 | 2 | 32µs | 2 | 125µs | # spent 67µs (9+58) within Fatal::BEGIN@22 which was called:
# once (9µs+58µs) by autodie::BEGIN@6 at line 22 # spent 67µs making 1 call to Fatal::BEGIN@22
# spent 58µs making 1 call to constant::import |
23 | 2 | 27µs | 2 | 129µs | # spent 69µs (10+60) within Fatal::BEGIN@23 which was called:
# once (10µs+60µs) by autodie::BEGIN@6 at line 23 # spent 69µs making 1 call to Fatal::BEGIN@23
# spent 60µs making 1 call to constant::import |
24 | |||||
25 | 2 | 36µs | 2 | 126µs | # spent 68µs (10+58) within Fatal::BEGIN@25 which was called:
# once (10µs+58µs) by autodie::BEGIN@6 at line 25 # spent 68µs making 1 call to Fatal::BEGIN@25
# spent 58µs making 1 call to constant::import |
26 | |||||
27 | 2 | 28µs | 2 | 134µs | # spent 77µs (19+58) within Fatal::BEGIN@27 which was called:
# once (19µs+58µs) by autodie::BEGIN@6 at line 27 # spent 77µs making 1 call to Fatal::BEGIN@27
# spent 58µs making 1 call to constant::import |
28 | |||||
29 | 2 | 26µs | 2 | 124µs | # spent 67µs (9+57) within Fatal::BEGIN@29 which was called:
# once (9µs+57µs) by autodie::BEGIN@6 at line 29 # spent 67µs making 1 call to Fatal::BEGIN@29
# spent 57µs making 1 call to constant::import |
30 | |||||
31 | 2 | 27µs | 2 | 122µs | # spent 66µs (9+56) within Fatal::BEGIN@31 which was called:
# once (9µs+56µs) by autodie::BEGIN@6 at line 31 # spent 66µs making 1 call to Fatal::BEGIN@31
# spent 56µs making 1 call to constant::import |
32 | |||||
33 | 2 | 29µs | 2 | 131µs | # spent 71µs (10+61) within Fatal::BEGIN@33 which was called:
# once (10µs+61µs) by autodie::BEGIN@6 at line 33 # spent 71µs making 1 call to Fatal::BEGIN@33
# spent 61µs making 1 call to constant::import |
34 | |||||
35 | 2 | 32µs | 2 | 120µs | # spent 65µs (9+55) within Fatal::BEGIN@35 which was called:
# once (9µs+55µs) by autodie::BEGIN@6 at line 35 # spent 65µs making 1 call to Fatal::BEGIN@35
# spent 55µs making 1 call to constant::import |
36 | |||||
37 | # Older versions of IPC::System::Simple don't support all the | ||||
38 | # features we need. | ||||
39 | |||||
40 | 2 | 731µs | 2 | 123µs | # spent 67µs (11+56) within Fatal::BEGIN@40 which was called:
# once (11µs+56µs) by autodie::BEGIN@6 at line 40 # spent 67µs making 1 call to Fatal::BEGIN@40
# spent 56µs making 1 call to constant::import |
41 | |||||
42 | # All the Fatal/autodie modules share the same version number. | ||||
43 | 1 | 1µs | our $VERSION = '2.10'; | ||
44 | |||||
45 | 1 | 1µs | our $Debug ||= 0; | ||
46 | |||||
47 | # EWOULDBLOCK values for systems that don't supply their own. | ||||
48 | # Even though this is defined with our, that's to help our | ||||
49 | # test code. Please don't rely upon this variable existing in | ||||
50 | # the future. | ||||
51 | |||||
52 | 1 | 3µs | our %_EWOULDBLOCK = ( | ||
53 | MSWin32 => 33, | ||||
54 | ); | ||||
55 | |||||
56 | # the linux parisc port has separate EAGAIN and EWOULDBLOCK, | ||||
57 | # and the kernel returns EAGAIN | ||||
58 | 1 | 17µs | 2 | 11µs | my $try_EAGAIN = ($^O eq 'linux' and $Config{archname} =~ /hppa|parisc/) ? 1 : 0; # spent 7µs making 1 call to Config::FETCH
# spent 4µs making 1 call to Fatal::CORE:match |
59 | |||||
60 | # We have some tags that can be passed in for use with import. | ||||
61 | # These are all assumed to be CORE:: | ||||
62 | |||||
63 | 1 | 29µs | my %TAGS = ( | ||
64 | ':io' => [qw(:dbm :file :filesys :ipc :socket | ||||
65 | read seek sysread syswrite sysseek )], | ||||
66 | ':dbm' => [qw(dbmopen dbmclose)], | ||||
67 | ':file' => [qw(open close flock sysopen fcntl fileno binmode | ||||
68 | ioctl truncate chmod)], | ||||
69 | ':filesys' => [qw(opendir closedir chdir link unlink rename mkdir | ||||
70 | symlink rmdir readlink umask)], | ||||
71 | ':ipc' => [qw(:msg :semaphore :shm pipe)], | ||||
72 | ':msg' => [qw(msgctl msgget msgrcv msgsnd)], | ||||
73 | ':threads' => [qw(fork)], | ||||
74 | ':semaphore'=>[qw(semctl semget semop)], | ||||
75 | ':shm' => [qw(shmctl shmget shmread)], | ||||
76 | ':system' => [qw(system exec)], | ||||
77 | |||||
78 | # Can we use qw(getpeername getsockname)? What do they do on failure? | ||||
79 | # TODO - Can socket return false? | ||||
80 | ':socket' => [qw(accept bind connect getsockopt listen recv send | ||||
81 | setsockopt shutdown socketpair)], | ||||
82 | |||||
83 | # Our defaults don't include system(), because it depends upon | ||||
84 | # an optional module, and it breaks the exotic form. | ||||
85 | # | ||||
86 | # This *may* change in the future. I'd love IPC::System::Simple | ||||
87 | # to be a dependency rather than a recommendation, and hence for | ||||
88 | # system() to be autodying by default. | ||||
89 | |||||
90 | ':default' => [qw(:io :threads)], | ||||
91 | |||||
92 | # Everything in v2.07 and brefore. This was :default less chmod. | ||||
93 | ':v207' => [qw(:threads :dbm :filesys :ipc :socket read seek sysread | ||||
94 | syswrite sysseek open close flock sysopen fcntl fileno | ||||
95 | binmode ioctl truncate)], | ||||
96 | |||||
97 | # Version specific tags. These allow someone to specify | ||||
98 | # use autodie qw(:1.994) and know exactly what they'll get. | ||||
99 | |||||
100 | ':1.994' => [qw(:v207)], | ||||
101 | ':1.995' => [qw(:v207)], | ||||
102 | ':1.996' => [qw(:v207)], | ||||
103 | ':1.997' => [qw(:v207)], | ||||
104 | ':1.998' => [qw(:v207)], | ||||
105 | ':1.999' => [qw(:v207)], | ||||
106 | ':1.999_01' => [qw(:v207)], | ||||
107 | ':2.00' => [qw(:v207)], | ||||
108 | ':2.01' => [qw(:v207)], | ||||
109 | ':2.02' => [qw(:v207)], | ||||
110 | ':2.03' => [qw(:v207)], | ||||
111 | ':2.04' => [qw(:v207)], | ||||
112 | ':2.05' => [qw(:v207)], | ||||
113 | ':2.06' => [qw(:v207)], | ||||
114 | ':2.06_01' => [qw(:v207)], | ||||
115 | ':2.07' => [qw(:v207)], # Last release without chmod | ||||
116 | ':2.08' => [qw(:default)], | ||||
117 | ':2.09' => [qw(:default)], | ||||
118 | ':2.10' => [qw(:default)], | ||||
119 | ); | ||||
120 | |||||
121 | # chmod was only introduced in 2.07 | ||||
122 | |||||
123 | 1 | 11µs | $TAGS{':all'} = [ keys %TAGS ]; | ||
124 | |||||
125 | # This hash contains subroutines for which we should | ||||
126 | # subroutine() // die() rather than subroutine() || die() | ||||
127 | |||||
128 | 1 | 1µs | my %Use_defined_or; | ||
129 | |||||
130 | # CORE::open returns undef on failure. It can legitimately return | ||||
131 | # 0 on success, eg: open(my $fh, '-|') || exec(...); | ||||
132 | |||||
133 | 1 | 5µs | @Use_defined_or{qw( | ||
134 | CORE::fork | ||||
135 | CORE::recv | ||||
136 | CORE::send | ||||
137 | CORE::open | ||||
138 | CORE::fileno | ||||
139 | CORE::read | ||||
140 | CORE::readlink | ||||
141 | CORE::sysread | ||||
142 | CORE::syswrite | ||||
143 | CORE::sysseek | ||||
144 | CORE::umask | ||||
145 | )} = (); | ||||
146 | |||||
147 | # Cached_fatalised_sub caches the various versions of our | ||||
148 | # fatalised subs as they're produced. This means we don't | ||||
149 | # have to build our own replacement of CORE::open and friends | ||||
150 | # for every single package that wants to use them. | ||||
151 | |||||
152 | 1 | 1µs | my %Cached_fatalised_sub = (); | ||
153 | |||||
154 | # Every time we're called with package scope, we record the subroutine | ||||
155 | # (including package or CORE::) in %Package_Fatal. This allows us | ||||
156 | # to detect illegal combinations of autodie and Fatal, and makes sure | ||||
157 | # we don't accidently make a Fatal function autodying (which isn't | ||||
158 | # very useful). | ||||
159 | |||||
160 | 1 | 1µs | my %Package_Fatal = (); | ||
161 | |||||
162 | # The first time we're called with a user-sub, we cache it here. | ||||
163 | # In the case of a "no autodie ..." we put back the cached copy. | ||||
164 | |||||
165 | 1 | 1µs | my %Original_user_sub = (); | ||
166 | |||||
167 | # Is_fatalised_sub simply records a big map of fatalised subroutine | ||||
168 | # refs. It means we can avoid repeating work, or fatalising something | ||||
169 | # we've already processed. | ||||
170 | |||||
171 | 1 | 800ns | my %Is_fatalised_sub = (); | ||
172 | 1 | 7µs | 1 | 17µs | tie %Is_fatalised_sub, 'Tie::RefHash'; # spent 17µs making 1 call to Tie::RefHash::TIEHASH |
173 | |||||
174 | # We use our package in a few hash-keys. Having it in a scalar is | ||||
175 | # convenient. The "guard $PACKAGE" string is used as a key when | ||||
176 | # setting up lexical guards. | ||||
177 | |||||
178 | 1 | 1µs | my $PACKAGE = __PACKAGE__; | ||
179 | 1 | 2µs | my $PACKAGE_GUARD = "guard $PACKAGE"; | ||
180 | 1 | 1µs | my $NO_PACKAGE = "no $PACKAGE"; # Used to detect 'no autodie' | ||
181 | |||||
182 | # Here's where all the magic happens when someone write 'use Fatal' | ||||
183 | # or 'use autodie'. | ||||
184 | |||||
185 | # spent 2.33ms (106µs+2.22) within Fatal::import which was called:
# once (106µs+2.22ms) by Hailo::BEGIN@4 at line 58 of autodie.pm | ||||
186 | 1 | 2µs | my $class = shift(@_); | ||
187 | 1 | 2µs | my @original_args = @_; | ||
188 | 1 | 1µs | my $void = 0; | ||
189 | 1 | 600ns | my $lexical = 0; | ||
190 | 1 | 800ns | my $insist_hints = 0; | ||
191 | |||||
192 | 1 | 2µs | my ($pkg, $filename) = caller(); | ||
193 | |||||
194 | 1 | 1µs | @_ or return; # 'use Fatal' is a no-op. | ||
195 | |||||
196 | # If we see the :lexical flag, then _all_ arguments are | ||||
197 | # changed lexically | ||||
198 | |||||
199 | 1 | 2µs | if ($_[0] eq LEXICAL_TAG) { | ||
200 | 1 | 1µs | $lexical = 1; | ||
201 | 1 | 900ns | shift @_; | ||
202 | |||||
203 | # If we see no arguments and :lexical, we assume they | ||||
204 | # wanted ':default'. | ||||
205 | |||||
206 | 1 | 1µs | if (@_ == 0) { | ||
207 | push(@_, ':default'); | ||||
208 | } | ||||
209 | |||||
210 | # Don't allow :lexical with :void, it's needlessly confusing. | ||||
211 | 1 | 2µs | if ( grep { $_ eq VOID_TAG } @_ ) { | ||
212 | croak(ERROR_VOID_LEX); | ||||
213 | } | ||||
214 | } | ||||
215 | |||||
216 | 1 | 1µs | if ( grep { $_ eq LEXICAL_TAG } @_ ) { | ||
217 | # If we see the lexical tag as the non-first argument, complain. | ||||
218 | croak(ERROR_LEX_FIRST); | ||||
219 | } | ||||
220 | |||||
221 | 1 | 2µs | my @fatalise_these = @_; | ||
222 | |||||
223 | # Thiese subs will get unloaded at the end of lexical scope. | ||||
224 | 1 | 1µs | my %unload_later; | ||
225 | |||||
226 | # This hash helps us track if we've alredy done work. | ||||
227 | 1 | 700ns | my %done_this; | ||
228 | |||||
229 | # NB: we're using while/shift rather than foreach, since | ||||
230 | # we'll be modifying the array as we walk through it. | ||||
231 | |||||
232 | 1 | 8µs | while (my $func = shift @fatalise_these) { | ||
233 | |||||
234 | 2 | 5µs | if ($func eq VOID_TAG) { | ||
235 | |||||
236 | # When we see :void, set the void flag. | ||||
237 | $void = 1; | ||||
238 | |||||
239 | } elsif ($func eq INSIST_TAG) { | ||||
240 | |||||
241 | $insist_hints = 1; | ||||
242 | |||||
243 | } elsif (exists $TAGS{$func}) { | ||||
244 | |||||
245 | # When it's a tag, expand it. | ||||
246 | push(@fatalise_these, @{ $TAGS{$func} }); | ||||
247 | |||||
248 | } else { | ||||
249 | |||||
250 | # Otherwise, fatalise it. | ||||
251 | |||||
252 | # Check to see if there's an insist flag at the front. | ||||
253 | # If so, remove it, and insist we have hints for this sub. | ||||
254 | 2 | 2µs | my $insist_this; | ||
255 | |||||
256 | 2 | 12µs | 2 | 3µs | if ($func =~ s/^!//) { # spent 3µs making 2 calls to Fatal::CORE:subst, avg 2µs/call |
257 | $insist_this = 1; | ||||
258 | } | ||||
259 | |||||
260 | # TODO: Even if we've already fatalised, we should | ||||
261 | # check we've done it with hints (if $insist_hints). | ||||
262 | |||||
263 | # If we've already made something fatal this call, | ||||
264 | # then don't do it twice. | ||||
265 | |||||
266 | 2 | 2µs | next if $done_this{$func}; | ||
267 | |||||
268 | # We're going to make a subroutine fatalistic. | ||||
269 | # However if we're being invoked with 'use Fatal qw(x)' | ||||
270 | # and we've already been called with 'no autodie qw(x)' | ||||
271 | # in the same scope, we consider this to be an error. | ||||
272 | # Mixing Fatal and autodie effects was considered to be | ||||
273 | # needlessly confusing on p5p. | ||||
274 | |||||
275 | 2 | 2µs | my $sub = $func; | ||
276 | 2 | 11µs | 2 | 3µs | $sub = "${pkg}::$sub" unless $sub =~ /::/; # spent 3µs making 2 calls to Fatal::CORE:match, avg 1µs/call |
277 | |||||
278 | # If we're being called as Fatal, and we've previously | ||||
279 | # had a 'no X' in scope for the subroutine, then complain | ||||
280 | # bitterly. | ||||
281 | |||||
282 | 2 | 2µs | if (! $lexical and $^H{$NO_PACKAGE}{$sub}) { | ||
283 | croak(sprintf(ERROR_FATAL_CONFLICT, $func, $func)); | ||||
284 | } | ||||
285 | |||||
286 | # We're not being used in a confusing way, so make | ||||
287 | # the sub fatal. Note that _make_fatal returns the | ||||
288 | # old (original) version of the sub, or undef for | ||||
289 | # built-ins. | ||||
290 | |||||
291 | 2 | 11µs | 2 | 2.21ms | my $sub_ref = $class->_make_fatal( # spent 2.21ms making 2 calls to Fatal::_make_fatal, avg 1.10ms/call |
292 | $func, $pkg, $void, $lexical, $filename, | ||||
293 | ( $insist_this || $insist_hints ) | ||||
294 | ); | ||||
295 | |||||
296 | 2 | 3µs | $done_this{$func}++; | ||
297 | |||||
298 | 2 | 3µs | $Original_user_sub{$sub} ||= $sub_ref; | ||
299 | |||||
300 | # If we're making lexical changes, we need to arrange | ||||
301 | # for them to be cleaned at the end of our scope, so | ||||
302 | # record them here. | ||||
303 | |||||
304 | 2 | 3µs | $unload_later{$func} = $sub_ref if $lexical; | ||
305 | } | ||||
306 | } | ||||
307 | |||||
308 | 1 | 2µs | if ($lexical) { | ||
309 | |||||
310 | # Dark magic to have autodie work under 5.8 | ||||
311 | # Copied from namespace::clean, that copied it from | ||||
312 | # autobox, that found it on an ancient scroll written | ||||
313 | # in blood. | ||||
314 | |||||
315 | # This magic bit causes %^H to be lexically scoped. | ||||
316 | |||||
317 | 1 | 2µs | $^H |= 0x020000; | ||
318 | |||||
319 | # Our package guard gets invoked when we leave our lexical | ||||
320 | # scope. | ||||
321 | |||||
322 | push(@ { $^H{$PACKAGE_GUARD} }, autodie::Scope::Guard->new(sub { | ||||
323 | $class->_install_subs($pkg, \%unload_later); | ||||
324 | 1 | 11µs | 1 | 9µs | })); # spent 9µs making 1 call to autodie::Scope::Guard::new |
325 | |||||
326 | # To allow others to determine when autodie was in scope, | ||||
327 | # and with what arguments, we also set a %^H hint which | ||||
328 | # is how we were called. | ||||
329 | |||||
330 | # This feature should be considered EXPERIMENTAL, and | ||||
331 | # may change without notice. Please e-mail pjf@cpan.org | ||||
332 | # if you're actually using it. | ||||
333 | |||||
334 | 1 | 5µs | $^H{autodie} = "$PACKAGE @original_args"; | ||
335 | |||||
336 | } | ||||
337 | |||||
338 | 1 | 6µs | return; | ||
339 | |||||
340 | } | ||||
341 | |||||
342 | # The code here is originally lifted from namespace::clean, | ||||
343 | # by Robert "phaylon" Sedlacek. | ||||
344 | # | ||||
345 | # It's been redesigned after feedback from ikegami on perlmonks. | ||||
346 | # See http://perlmonks.org/?node_id=693338 . Ikegami rocks. | ||||
347 | # | ||||
348 | # Given a package, and hash of (subname => subref) pairs, | ||||
349 | # we install the given subroutines into the package. If | ||||
350 | # a subref is undef, the subroutine is removed. Otherwise | ||||
351 | # it replaces any existing subs which were already there. | ||||
352 | |||||
353 | # spent 81µs within Fatal::_install_subs which was called 2 times, avg 40µs/call:
# 2 times (81µs+0s) by Fatal::_make_fatal at line 1198, avg 40µs/call | ||||
354 | 2 | 4µs | my ($class, $pkg, $subs_to_reinstate) = @_; | ||
355 | |||||
356 | 2 | 3µs | my $pkg_sym = "${pkg}::"; | ||
357 | |||||
358 | 2 | 13µs | while(my ($sub_name, $sub_ref) = each %$subs_to_reinstate) { | ||
359 | |||||
360 | 2 | 2µs | my $full_path = $pkg_sym.$sub_name; | ||
361 | |||||
362 | # Copy symbols across to temp area. | ||||
363 | |||||
364 | 2 | 36µs | 2 | 63µs | # spent 38µs (12+26) within Fatal::BEGIN@364 which was called:
# once (12µs+26µs) by autodie::BEGIN@6 at line 364 # spent 38µs making 1 call to Fatal::BEGIN@364
# spent 26µs making 1 call to strict::unimport |
365 | |||||
366 | 2 | 6µs | local *__tmp = *{ $full_path }; | ||
367 | |||||
368 | # Nuke the old glob. | ||||
369 | 6 | 73µs | 2 | 20µs | # spent 16µs (11+5) within Fatal::BEGIN@369 which was called:
# once (11µs+5µs) by autodie::BEGIN@6 at line 369 # spent 16µs making 1 call to Fatal::BEGIN@369
# spent 5µs making 1 call to strict::unimport |
370 | |||||
371 | # Copy innocent bystanders back. Note that we lose | ||||
372 | # formats; it seems that Perl versions up to 5.10.0 | ||||
373 | # have a bug which causes copying formats to end up in | ||||
374 | # the scalar slot. Thanks to Ben Morrow for spotting this. | ||||
375 | |||||
376 | 2 | 13µs | foreach my $slot (qw( SCALAR ARRAY HASH IO ) ) { | ||
377 | 8 | 9µs | next unless defined *__tmp{ $slot }; | ||
378 | 2 | 7µs | *{ $full_path } = *__tmp{ $slot }; | ||
379 | } | ||||
380 | |||||
381 | # Put back the old sub (if there was one). | ||||
382 | |||||
383 | 2 | 5µs | if ($sub_ref) { | ||
384 | |||||
385 | 2 | 1.90ms | 2 | 24µs | # spent 19µs (15+5) within Fatal::BEGIN@385 which was called:
# once (15µs+5µs) by autodie::BEGIN@6 at line 385 # spent 19µs making 1 call to Fatal::BEGIN@385
# spent 5µs making 1 call to strict::unimport |
386 | 2 | 4µs | *{ $pkg_sym . $sub_name } = $sub_ref; | ||
387 | } | ||||
388 | } | ||||
389 | |||||
390 | 2 | 11µs | return; | ||
391 | } | ||||
392 | |||||
393 | sub unimport { | ||||
394 | my $class = shift; | ||||
395 | |||||
396 | # Calling "no Fatal" must start with ":lexical" | ||||
397 | if ($_[0] ne LEXICAL_TAG) { | ||||
398 | croak(sprintf(ERROR_NO_LEX,$class)); | ||||
399 | } | ||||
400 | |||||
401 | shift @_; # Remove :lexical | ||||
402 | |||||
403 | my $pkg = (caller)[0]; | ||||
404 | |||||
405 | # If we've been called with arguments, then the developer | ||||
406 | # has explicitly stated 'no autodie qw(blah)', | ||||
407 | # in which case, we disable Fatalistic behaviour for 'blah'. | ||||
408 | |||||
409 | my @unimport_these = @_ ? @_ : ':all'; | ||||
410 | |||||
411 | while (my $symbol = shift @unimport_these) { | ||||
412 | |||||
413 | if ($symbol =~ /^:/) { | ||||
414 | |||||
415 | # Looks like a tag! Expand it! | ||||
416 | push(@unimport_these, @{ $TAGS{$symbol} }); | ||||
417 | |||||
418 | next; | ||||
419 | } | ||||
420 | |||||
421 | my $sub = $symbol; | ||||
422 | $sub = "${pkg}::$sub" unless $sub =~ /::/; | ||||
423 | |||||
424 | # If 'blah' was already enabled with Fatal (which has package | ||||
425 | # scope) then, this is considered an error. | ||||
426 | |||||
427 | if (exists $Package_Fatal{$sub}) { | ||||
428 | croak(sprintf(ERROR_AUTODIE_CONFLICT,$symbol,$symbol)); | ||||
429 | } | ||||
430 | |||||
431 | # Record 'no autodie qw($sub)' as being in effect. | ||||
432 | # This is to catch conflicting semantics elsewhere | ||||
433 | # (eg, mixing Fatal with no autodie) | ||||
434 | |||||
435 | $^H{$NO_PACKAGE}{$sub} = 1; | ||||
436 | |||||
437 | if (my $original_sub = $Original_user_sub{$sub}) { | ||||
438 | # Hey, we've got an original one of these, put it back. | ||||
439 | $class->_install_subs($pkg, { $symbol => $original_sub }); | ||||
440 | next; | ||||
441 | } | ||||
442 | |||||
443 | # We don't have an original copy of the sub, on the assumption | ||||
444 | # it's core (or doesn't exist), we'll just nuke it. | ||||
445 | |||||
446 | $class->_install_subs($pkg,{ $symbol => undef }); | ||||
447 | |||||
448 | } | ||||
449 | |||||
450 | return; | ||||
451 | |||||
452 | } | ||||
453 | |||||
454 | # TODO - This is rather terribly inefficient right now. | ||||
455 | |||||
456 | # NB: Perl::Critic's dump-autodie-tag-contents depends upon this | ||||
457 | # continuing to work. | ||||
458 | |||||
459 | { | ||||
460 | 2 | 3µs | my %tag_cache; | ||
461 | |||||
462 | sub _expand_tag { | ||||
463 | my ($class, $tag) = @_; | ||||
464 | |||||
465 | if (my $cached = $tag_cache{$tag}) { | ||||
466 | return $cached; | ||||
467 | } | ||||
468 | |||||
469 | if (not exists $TAGS{$tag}) { | ||||
470 | croak "Invalid exception class $tag"; | ||||
471 | } | ||||
472 | |||||
473 | my @to_process = @{$TAGS{$tag}}; | ||||
474 | |||||
475 | my @taglist = (); | ||||
476 | |||||
477 | while (my $item = shift @to_process) { | ||||
478 | if ($item =~ /^:/) { | ||||
479 | # Expand :tags | ||||
480 | push(@to_process, @{$TAGS{$item}} ); | ||||
481 | } | ||||
482 | else { | ||||
483 | push(@taglist, "CORE::$item"); | ||||
484 | } | ||||
485 | } | ||||
486 | |||||
487 | $tag_cache{$tag} = \@taglist; | ||||
488 | |||||
489 | return \@taglist; | ||||
490 | |||||
491 | } | ||||
492 | |||||
493 | } | ||||
494 | |||||
495 | # This code is from the original Fatal. It scares me. | ||||
496 | # It is 100% compatible with the 5.10.0 Fatal module, right down | ||||
497 | # to the scary 'XXXX' comment. ;) | ||||
498 | |||||
499 | # spent 152µs (113+39) within Fatal::fill_protos which was called 2 times, avg 76µs/call:
# 2 times (113µs+39µs) by Fatal::_make_fatal at line 1081, avg 76µs/call | ||||
500 | 2 | 2µs | my $proto = shift; | ||
501 | 2 | 3µs | my ($n, $isref, @out, @out1, $seen_semi) = -1; | ||
502 | 2 | 35µs | 7 | 11µs | while ($proto =~ /\S/) { # spent 11µs making 7 calls to Fatal::CORE:match, avg 2µs/call |
503 | 6 | 6µs | $n++; | ||
504 | 6 | 10µs | push(@out1,[$n,@out]) if $seen_semi; | ||
505 | 6 | 24µs | 6 | 7µs | push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//; # spent 7µs making 6 calls to Fatal::CORE:subst, avg 1µs/call |
506 | 6 | 31µs | 6 | 10µs | push(@out, "\$_[$n]"), next if $proto =~ s/^\s*([_*\$&])//; # spent 10µs making 6 calls to Fatal::CORE:subst, avg 2µs/call |
507 | 3 | 18µs | 3 | 7µs | push(@out, "\@_[$n..\$#_]"), last if $proto =~ s/^\s*(;\s*)?\@//; # spent 7µs making 3 calls to Fatal::CORE:subst, avg 2µs/call |
508 | 2 | 12µs | 2 | 4µs | $seen_semi = 1, $n--, next if $proto =~ s/^\s*;//; # XXXX ???? # spent 4µs making 2 calls to Fatal::CORE:subst, avg 2µs/call |
509 | die "Internal error: Unknown prototype letters: \"$proto\""; | ||||
510 | } | ||||
511 | 2 | 4µs | push(@out1,[$n+1,@out]); | ||
512 | 2 | 10µs | return @out1; | ||
513 | } | ||||
514 | |||||
515 | # This is a backwards compatible version of _write_invocation. It's | ||||
516 | # recommended you don't use it. | ||||
517 | |||||
518 | sub write_invocation { | ||||
519 | my ($core, $call, $name, $void, @args) = @_; | ||||
520 | |||||
521 | return Fatal->_write_invocation( | ||||
522 | $core, $call, $name, $void, | ||||
523 | 0, # Lexical flag | ||||
524 | undef, # Sub, unused in legacy mode | ||||
525 | undef, # Subref, unused in legacy mode. | ||||
526 | @args | ||||
527 | ); | ||||
528 | } | ||||
529 | |||||
530 | # This version of _write_invocation is used internally. It's not | ||||
531 | # recommended you call it from external code, as the interface WILL | ||||
532 | # change in the future. | ||||
533 | |||||
534 | # spent 265µs (122+144) within Fatal::_write_invocation which was called 2 times, avg 133µs/call:
# 2 times (122µs+144µs) by Fatal::_make_fatal at line 1082, avg 133µs/call | ||||
535 | |||||
536 | 2 | 5µs | my ($class, $core, $call, $name, $void, $lexical, $sub, $sref, @argvs) = @_; | ||
537 | |||||
538 | 2 | 3µs | if (@argvs == 1) { # No optional arguments | ||
539 | |||||
540 | my @argv = @{$argvs[0]}; | ||||
541 | shift @argv; | ||||
542 | |||||
543 | return $class->_one_invocation($core,$call,$name,$void,$sub,! $lexical, $sref, @argv); | ||||
544 | |||||
545 | } else { | ||||
546 | 2 | 2µs | my $else = "\t"; | ||
547 | 2 | 2µs | my (@out, @argv, $n); | ||
548 | 2 | 4µs | while (@argvs) { | ||
549 | 5 | 10µs | @argv = @{shift @argvs}; | ||
550 | 5 | 5µs | $n = shift @argv; | ||
551 | |||||
552 | 5 | 7µs | my $condition = "\@_ == $n"; | ||
553 | |||||
554 | 5 | 21µs | 4 | 6µs | if (@argv and $argv[-1] =~ /#_/) { # spent 6µs making 4 calls to Fatal::CORE:match, avg 2µs/call |
555 | # This argv ends with '@' in the prototype, so it matches | ||||
556 | # any number of args >= the number of expressions in the | ||||
557 | # argv. | ||||
558 | $condition = "\@_ >= $n"; | ||||
559 | } | ||||
560 | |||||
561 | 5 | 8µs | push @out, "${else}if ($condition) {\n"; | ||
562 | |||||
563 | 5 | 5µs | $else = "\t} els"; | ||
564 | |||||
565 | 5 | 30µs | 5 | 138µs | push @out, $class->_one_invocation($core,$call,$name,$void,$sub,! $lexical, $sref, @argv); # spent 138µs making 5 calls to Fatal::_one_invocation, avg 28µs/call |
566 | } | ||||
567 | 2 | 4µs | push @out, qq[ | ||
568 | } | ||||
569 | die "Internal error: $name(\@_): Do not expect to get ", scalar(\@_), " arguments"; | ||||
570 | ]; | ||||
571 | |||||
572 | 2 | 17µs | return join '', @out; | ||
573 | } | ||||
574 | } | ||||
575 | |||||
576 | |||||
577 | # This is a slim interface to ensure backward compatibility with | ||||
578 | # anyone doing very foolish things with old versions of Fatal. | ||||
579 | |||||
580 | sub one_invocation { | ||||
581 | my ($core, $call, $name, $void, @argv) = @_; | ||||
582 | |||||
583 | return Fatal->_one_invocation( | ||||
584 | $core, $call, $name, $void, | ||||
585 | undef, # Sub. Unused in back-compat mode. | ||||
586 | 1, # Back-compat flag | ||||
587 | undef, # Subref, unused in back-compat mode. | ||||
588 | @argv | ||||
589 | ); | ||||
590 | |||||
591 | } | ||||
592 | |||||
593 | # This is the internal interface that generates code. | ||||
594 | # NOTE: This interface WILL change in the future. Please do not | ||||
595 | # call this subroutine directly. | ||||
596 | |||||
597 | # TODO: Whatever's calling this code has already looked up hints. Pass | ||||
598 | # them in, rather than look them up a second time. | ||||
599 | |||||
600 | # spent 138µs within Fatal::_one_invocation which was called 5 times, avg 28µs/call:
# 5 times (138µs+0s) by Fatal::_write_invocation at line 565, avg 28µs/call | ||||
601 | 5 | 11µs | my ($class, $core, $call, $name, $void, $sub, $back_compat, $sref, @argv) = @_; | ||
602 | |||||
603 | |||||
604 | # If someone is calling us directly (a child class perhaps?) then | ||||
605 | # they could try to mix void without enabling backwards | ||||
606 | # compatibility. We just don't support this at all, so we gripe | ||||
607 | # about it rather than doing something unwise. | ||||
608 | |||||
609 | 5 | 5µs | if ($void and not $back_compat) { | ||
610 | Carp::confess("Internal error: :void mode not supported with $class"); | ||||
611 | } | ||||
612 | |||||
613 | # @argv only contains the results of the in-built prototype | ||||
614 | # function, and is therefore safe to interpolate in the | ||||
615 | # code generators below. | ||||
616 | |||||
617 | # TODO - The following clobbers context, but that's what the | ||||
618 | # old Fatal did. Do we care? | ||||
619 | |||||
620 | 5 | 4µs | if ($back_compat) { | ||
621 | |||||
622 | # Use Fatal qw(system) will never be supported. It generated | ||||
623 | # a compile-time error with legacy Fatal, and there's no reason | ||||
624 | # to support it when autodie does a better job. | ||||
625 | |||||
626 | if ($call eq 'CORE::system') { | ||||
627 | return q{ | ||||
628 | croak("UNIMPLEMENTED: use Fatal qw(system) not supported."); | ||||
629 | }; | ||||
630 | } | ||||
631 | |||||
632 | local $" = ', '; | ||||
633 | |||||
634 | if ($void) { | ||||
635 | return qq/return (defined wantarray)?$call(@argv): | ||||
636 | $call(@argv) || Carp::croak("Can't $name(\@_)/ . | ||||
637 | ($core ? ': $!' : ', \$! is \"$!\"') . '")' | ||||
638 | } else { | ||||
639 | return qq{return $call(@argv) || Carp::croak("Can't $name(\@_)} . | ||||
640 | ($core ? ': $!' : ', \$! is \"$!\"') . '")'; | ||||
641 | } | ||||
642 | } | ||||
643 | |||||
644 | # The name of our original function is: | ||||
645 | # $call if the function is CORE | ||||
646 | # $sub if our function is non-CORE | ||||
647 | |||||
648 | # The reason for this is that $call is what we're actualling | ||||
649 | # calling. For our core functions, this is always | ||||
650 | # CORE::something. However for user-defined subs, we're about to | ||||
651 | # replace whatever it is that we're calling; as such, we actually | ||||
652 | # calling a subroutine ref. | ||||
653 | |||||
654 | 5 | 5µs | my $human_sub_name = $core ? $call : $sub; | ||
655 | |||||
656 | # Should we be testing to see if our result is defined, or | ||||
657 | # just true? | ||||
658 | |||||
659 | 5 | 4µs | my $use_defined_or; | ||
660 | |||||
661 | 5 | 3µs | my $hints; # All user-sub hints, including list hints. | ||
662 | |||||
663 | 5 | 6µs | if ( $core ) { | ||
664 | |||||
665 | # Core hints are built into autodie. | ||||
666 | |||||
667 | $use_defined_or = exists ( $Use_defined_or{$call} ); | ||||
668 | |||||
669 | } | ||||
670 | else { | ||||
671 | |||||
672 | # User sub hints are looked up using autodie::hints, | ||||
673 | # since users may wish to add their own hints. | ||||
674 | |||||
675 | require autodie::hints; | ||||
676 | |||||
677 | $hints = autodie::hints->get_hints_for( $sref ); | ||||
678 | |||||
679 | # We'll look up the sub's fullname. This means we | ||||
680 | # get better reports of where it came from in our | ||||
681 | # error messages, rather than what imported it. | ||||
682 | |||||
683 | $human_sub_name = autodie::hints->sub_fullname( $sref ); | ||||
684 | |||||
685 | } | ||||
686 | |||||
687 | # Checks for special core subs. | ||||
688 | |||||
689 | 5 | 5µs | if ($call eq 'CORE::system') { | ||
690 | |||||
691 | # Leverage IPC::System::Simple if we're making an autodying | ||||
692 | # system. | ||||
693 | |||||
694 | local $" = ", "; | ||||
695 | |||||
696 | # We need to stash $@ into $E, rather than using | ||||
697 | # local $@ for the whole sub. If we don't then | ||||
698 | # any exceptions from internal errors in autodie/Fatal | ||||
699 | # will mysteriously disappear before propogating | ||||
700 | # upwards. | ||||
701 | |||||
702 | return qq{ | ||||
703 | my \$retval; | ||||
704 | my \$E; | ||||
705 | |||||
706 | |||||
707 | { | ||||
708 | local \$@; | ||||
709 | |||||
710 | eval { | ||||
711 | \$retval = IPC::System::Simple::system(@argv); | ||||
712 | }; | ||||
713 | |||||
714 | \$E = \$@; | ||||
715 | } | ||||
716 | |||||
717 | if (\$E) { | ||||
718 | |||||
719 | # TODO - This can't be overridden in child | ||||
720 | # classes! | ||||
721 | |||||
722 | die autodie::exception::system->new( | ||||
723 | function => q{CORE::system}, args => [ @argv ], | ||||
724 | message => "\$E", errno => \$!, | ||||
725 | ); | ||||
726 | } | ||||
727 | |||||
728 | return \$retval; | ||||
729 | }; | ||||
730 | |||||
731 | } | ||||
732 | |||||
733 | 5 | 6µs | local $" = ', '; | ||
734 | |||||
735 | # If we're going to throw an exception, here's the code to use. | ||||
736 | 5 | 13µs | my $die = qq{ | ||
737 | die $class->throw( | ||||
738 | function => q{$human_sub_name}, args => [ @argv ], | ||||
739 | pragma => q{$class}, errno => \$!, | ||||
740 | context => \$context, return => \$retval, | ||||
741 | eval_error => \$@ | ||||
742 | ) | ||||
743 | }; | ||||
744 | |||||
745 | 5 | 5µs | if ($call eq 'CORE::flock') { | ||
746 | |||||
747 | # flock needs special treatment. When it fails with | ||||
748 | # LOCK_UN and EWOULDBLOCK, then it's not really fatal, it just | ||||
749 | # means we couldn't get the lock right now. | ||||
750 | |||||
751 | require POSIX; # For POSIX::EWOULDBLOCK | ||||
752 | |||||
753 | local $@; # Don't blat anyone else's $@. | ||||
754 | |||||
755 | # Ensure that our vendor supports EWOULDBLOCK. If they | ||||
756 | # don't (eg, Windows), then we use known values for its | ||||
757 | # equivalent on other systems. | ||||
758 | |||||
759 | my $EWOULDBLOCK = eval { POSIX::EWOULDBLOCK(); } | ||||
760 | || $_EWOULDBLOCK{$^O} | ||||
761 | || _autocroak("Internal error - can't overload flock - EWOULDBLOCK not defined on this system."); | ||||
762 | my $EAGAIN = $EWOULDBLOCK; | ||||
763 | if ($try_EAGAIN) { | ||||
764 | $EAGAIN = eval { POSIX::EAGAIN(); } | ||||
765 | || _autocroak("Internal error - can't overload flock - EAGAIN not defined on this system."); | ||||
766 | } | ||||
767 | |||||
768 | require Fcntl; # For Fcntl::LOCK_NB | ||||
769 | |||||
770 | return qq{ | ||||
771 | |||||
772 | my \$context = wantarray() ? "list" : "scalar"; | ||||
773 | |||||
774 | # Try to flock. If successful, return it immediately. | ||||
775 | |||||
776 | my \$retval = $call(@argv); | ||||
777 | return \$retval if \$retval; | ||||
778 | |||||
779 | # If we failed, but we're using LOCK_NB and | ||||
780 | # returned EWOULDBLOCK, it's not a real error. | ||||
781 | |||||
782 | if (\$_[1] & Fcntl::LOCK_NB() and | ||||
783 | (\$! == $EWOULDBLOCK or | ||||
784 | ($try_EAGAIN and \$! == $EAGAIN ))) { | ||||
785 | return \$retval; | ||||
786 | } | ||||
787 | |||||
788 | # Otherwise, we failed. Die noisily. | ||||
789 | |||||
790 | $die; | ||||
791 | |||||
792 | }; | ||||
793 | } | ||||
794 | |||||
795 | # AFAIK everything that can be given an unopned filehandle | ||||
796 | # will fail if it tries to use it, so we don't really need | ||||
797 | # the 'unopened' warning class here. Especially since they | ||||
798 | # then report the wrong line number. | ||||
799 | |||||
800 | # Other warnings are disabled because they produce excessive | ||||
801 | # complaints from smart-match hints under 5.10.1. | ||||
802 | |||||
803 | 5 | 9µs | my $code = qq[ | ||
804 | no warnings qw(unopened uninitialized numeric); | ||||
805 | |||||
806 | if (wantarray) { | ||||
807 | my \@results = $call(@argv); | ||||
808 | my \$retval = \\\@results; | ||||
809 | my \$context = "list"; | ||||
810 | |||||
811 | ]; | ||||
812 | |||||
813 | 5 | 10µs | if ( $hints and ( ref($hints->{list} ) || "" ) eq 'CODE' ) { | ||
814 | |||||
815 | # NB: Subroutine hints are passed as a full list. | ||||
816 | # This differs from the 5.10.0 smart-match behaviour, | ||||
817 | # but means that context unaware subroutines can use | ||||
818 | # the same hints in both list and scalar context. | ||||
819 | |||||
820 | $code .= qq{ | ||||
821 | if ( \$hints->{list}->(\@results) ) { $die }; | ||||
822 | }; | ||||
823 | } | ||||
824 | elsif ( PERL510 and $hints ) { | ||||
825 | $code .= qq{ | ||||
826 | if ( \@results ~~ \$hints->{list} ) { $die }; | ||||
827 | }; | ||||
828 | } | ||||
829 | elsif ( $hints ) { | ||||
830 | croak sprintf(ERROR_58_HINTS, 'list', $sub); | ||||
831 | } | ||||
832 | else { | ||||
833 | 5 | 8µs | $code .= qq{ | ||
834 | # An empty list, or a single undef is failure | ||||
835 | if (! \@results or (\@results == 1 and ! defined \$results[0])) { | ||||
836 | $die; | ||||
837 | } | ||||
838 | } | ||||
839 | } | ||||
840 | |||||
841 | # Tidy up the end of our wantarray call. | ||||
842 | |||||
843 | 5 | 6µs | $code .= qq[ | ||
844 | return \@results; | ||||
845 | } | ||||
846 | ]; | ||||
847 | |||||
848 | |||||
849 | # Otherwise, we're in scalar context. | ||||
850 | # We're never in a void context, since we have to look | ||||
851 | # at the result. | ||||
852 | |||||
853 | 5 | 9µs | $code .= qq{ | ||
854 | my \$retval = $call(@argv); | ||||
855 | my \$context = "scalar"; | ||||
856 | }; | ||||
857 | |||||
858 | 5 | 5µs | if ( $hints and ( ref($hints->{scalar} ) || "" ) eq 'CODE' ) { | ||
859 | |||||
860 | # We always call code refs directly, since that always | ||||
861 | # works in 5.8.x, and always works in 5.10.1 | ||||
862 | |||||
863 | return $code .= qq{ | ||||
864 | if ( \$hints->{scalar}->(\$retval) ) { $die }; | ||||
865 | return \$retval; | ||||
866 | }; | ||||
867 | |||||
868 | } | ||||
869 | elsif (PERL510 and $hints) { | ||||
870 | return $code . qq{ | ||||
871 | |||||
872 | if ( \$retval ~~ \$hints->{scalar} ) { $die }; | ||||
873 | |||||
874 | return \$retval; | ||||
875 | }; | ||||
876 | } | ||||
877 | elsif ( $hints ) { | ||||
878 | croak sprintf(ERROR_58_HINTS, 'scalar', $sub); | ||||
879 | } | ||||
880 | |||||
881 | 5 | 29µs | return $code . | ||
882 | ( $use_defined_or ? qq{ | ||||
883 | |||||
884 | $die if not defined \$retval; | ||||
885 | |||||
886 | return \$retval; | ||||
887 | |||||
888 | } : qq{ | ||||
889 | |||||
890 | return \$retval || $die; | ||||
891 | |||||
892 | } ) ; | ||||
893 | |||||
894 | } | ||||
895 | |||||
896 | # This returns the old copy of the sub, so we can | ||||
897 | # put it back at end of scope. | ||||
898 | |||||
899 | # TODO : Check to make sure prototypes are restored correctly. | ||||
900 | |||||
901 | # TODO: Taking a huge list of arguments is awful. Rewriting to | ||||
902 | # take a hash would be lovely. | ||||
903 | |||||
904 | # TODO - BACKCOMPAT - This is not yet compatible with 5.10.0 | ||||
905 | |||||
906 | # spent 2.21ms (1.46+745µs) within Fatal::_make_fatal which was called 2 times, avg 1.10ms/call:
# 2 times (1.46ms+745µs) by Fatal::import at line 291, avg 1.10ms/call | ||||
907 | 2 | 4µs | my($class, $sub, $pkg, $void, $lexical, $filename, $insist) = @_; | ||
908 | 2 | 2µs | my($name, $code, $sref, $real_proto, $proto, $core, $call, $hints); | ||
909 | 2 | 2µs | my $ini = $sub; | ||
910 | |||||
911 | 2 | 9µs | 2 | 2µs | $sub = "${pkg}::$sub" unless $sub =~ /::/; # spent 2µs making 2 calls to Fatal::CORE:match, avg 1µs/call |
912 | |||||
913 | # Figure if we're using lexical or package semantics and | ||||
914 | # twiddle the appropriate bits. | ||||
915 | |||||
916 | 2 | 2µs | if (not $lexical) { | ||
917 | $Package_Fatal{$sub} = 1; | ||||
918 | } | ||||
919 | |||||
920 | # TODO - We *should* be able to do skipping, since we know when | ||||
921 | # we've lexicalised / unlexicalised a subroutine. | ||||
922 | |||||
923 | 2 | 2µs | $name = $sub; | ||
924 | 2 | 13µs | 2 | 6µs | $name =~ s/.*::// or $name =~ s/^&//; # spent 6µs making 2 calls to Fatal::CORE:subst, avg 3µs/call |
925 | |||||
926 | 2 | 2µs | warn "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug; | ||
927 | 2 | 10µs | 2 | 4µs | croak(sprintf(ERROR_BADNAME, $class, $name)) unless $name =~ /^\w+$/; # spent 4µs making 2 calls to Fatal::CORE:match, avg 2µs/call |
928 | |||||
929 | 2 | 6µs | if (defined(&$sub)) { # user subroutine | ||
930 | |||||
931 | # NOTE: Previously we would localise $@ at this point, so | ||||
932 | # the following calls to eval {} wouldn't interfere with anything | ||||
933 | # that's already in $@. Unfortunately, it would also stop | ||||
934 | # any of our croaks from triggering(!), which is even worse. | ||||
935 | |||||
936 | # This could be something that we've fatalised that | ||||
937 | # was in core. | ||||
938 | |||||
939 | if ( $Package_Fatal{$sub} and do { local $@; eval { prototype "CORE::$name" } } ) { | ||||
940 | |||||
941 | # Something we previously made Fatal that was core. | ||||
942 | # This is safe to replace with an autodying to core | ||||
943 | # version. | ||||
944 | |||||
945 | $core = 1; | ||||
946 | $call = "CORE::$name"; | ||||
947 | $proto = prototype $call; | ||||
948 | |||||
949 | # We return our $sref from this subroutine later | ||||
950 | # on, indicating this subroutine should be placed | ||||
951 | # back when we're finished. | ||||
952 | |||||
953 | $sref = \&$sub; | ||||
954 | |||||
955 | } else { | ||||
956 | |||||
957 | # If this is something we've already fatalised or played with, | ||||
958 | # then look-up the name of the original sub for the rest of | ||||
959 | # our processing. | ||||
960 | |||||
961 | $sub = $Is_fatalised_sub{\&$sub} || $sub; | ||||
962 | |||||
963 | # A regular user sub, or a user sub wrapping a | ||||
964 | # core sub. | ||||
965 | |||||
966 | $sref = \&$sub; | ||||
967 | $proto = prototype $sref; | ||||
968 | $call = '&$sref'; | ||||
969 | require autodie::hints; | ||||
970 | |||||
971 | $hints = autodie::hints->get_hints_for( $sref ); | ||||
972 | |||||
973 | # If we've insisted on hints, but don't have them, then | ||||
974 | # bail out! | ||||
975 | |||||
976 | if ($insist and not $hints) { | ||||
977 | croak(sprintf(ERROR_NOHINTS, $name)); | ||||
978 | } | ||||
979 | |||||
980 | # Otherwise, use the default hints if we don't have | ||||
981 | # any. | ||||
982 | |||||
983 | $hints ||= autodie::hints::DEFAULT_HINTS(); | ||||
984 | |||||
985 | } | ||||
986 | |||||
987 | } elsif ($sub eq $ini && $sub !~ /^CORE::GLOBAL::/) { | ||||
988 | # Stray user subroutine | ||||
989 | croak(sprintf(ERROR_NOTSUB,$sub)); | ||||
990 | |||||
991 | } elsif ($name eq 'system') { | ||||
992 | |||||
993 | # If we're fatalising system, then we need to load | ||||
994 | # helper code. | ||||
995 | |||||
996 | # The business with $E is to avoid clobbering our caller's | ||||
997 | # $@, and to avoid $@ being localised when we croak. | ||||
998 | |||||
999 | my $E; | ||||
1000 | |||||
1001 | { | ||||
1002 | local $@; | ||||
1003 | |||||
1004 | eval { | ||||
1005 | require IPC::System::Simple; # Only load it if we need it. | ||||
1006 | require autodie::exception::system; | ||||
1007 | }; | ||||
1008 | $E = $@; | ||||
1009 | } | ||||
1010 | |||||
1011 | if ($E) { croak ERROR_NO_IPC_SYS_SIMPLE; } | ||||
1012 | |||||
1013 | # Make sure we're using a recent version of ISS that actually | ||||
1014 | # support fatalised system. | ||||
1015 | if ($IPC::System::Simple::VERSION < MIN_IPC_SYS_SIMPLE_VER) { | ||||
1016 | croak sprintf( | ||||
1017 | ERROR_IPC_SYS_SIMPLE_OLD, MIN_IPC_SYS_SIMPLE_VER, | ||||
1018 | $IPC::System::Simple::VERSION | ||||
1019 | ); | ||||
1020 | } | ||||
1021 | |||||
1022 | $call = 'CORE::system'; | ||||
1023 | $name = 'system'; | ||||
1024 | $core = 1; | ||||
1025 | |||||
1026 | } elsif ($name eq 'exec') { | ||||
1027 | # Exec doesn't have a prototype. We don't care. This | ||||
1028 | # breaks the exotic form with lexical scope, and gives | ||||
1029 | # the regular form a "do or die" beaviour as expected. | ||||
1030 | |||||
1031 | $call = 'CORE::exec'; | ||||
1032 | $name = 'exec'; | ||||
1033 | $core = 1; | ||||
1034 | |||||
1035 | } else { # CORE subroutine | ||||
1036 | 2 | 2µs | my $E; | ||
1037 | { | ||||
1038 | 4 | 5µs | local $@; | ||
1039 | 4 | 24µs | $proto = eval { prototype "CORE::$name" }; | ||
1040 | 2 | 3µs | $E = $@; | ||
1041 | } | ||||
1042 | 2 | 1µs | croak(sprintf(ERROR_NOT_BUILT,$name)) if $E; | ||
1043 | 2 | 2µs | croak(sprintf(ERROR_CANT_OVERRIDE,$name)) if not defined $proto; | ||
1044 | 2 | 2µs | $core = 1; | ||
1045 | 2 | 3µs | $call = "CORE::$name"; | ||
1046 | } | ||||
1047 | |||||
1048 | 2 | 3µs | if (defined $proto) { | ||
1049 | $real_proto = " ($proto)"; | ||||
1050 | } else { | ||||
1051 | $real_proto = ''; | ||||
1052 | $proto = '@'; | ||||
1053 | } | ||||
1054 | |||||
1055 | 2 | 2µs | my $true_name = $core ? $call : $sub; | ||
1056 | |||||
1057 | # TODO: This caching works, but I don't like using $void and | ||||
1058 | # $lexical as keys. In particular, I suspect our code may end up | ||||
1059 | # wrapping already wrapped code when autodie and Fatal are used | ||||
1060 | # together. | ||||
1061 | |||||
1062 | # NB: We must use '$sub' (the name plus package) and not | ||||
1063 | # just '$name' (the short name) here. Failing to do so | ||||
1064 | # results code that's in the wrong package, and hence has | ||||
1065 | # access to the wrong package filehandles. | ||||
1066 | |||||
1067 | 2 | 6µs | if (my $subref = $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical}) { | ||
1068 | $class->_install_subs($pkg, { $name => $subref }); | ||||
1069 | return $sref; | ||||
1070 | } | ||||
1071 | |||||
1072 | 2 | 4µs | $code = qq[ | ||
1073 | sub$real_proto { | ||||
1074 | local(\$", \$!) = (', ', 0); # TODO - Why do we do this? | ||||
1075 | ]; | ||||
1076 | |||||
1077 | # Don't have perl whine if exec fails, since we'll be handling | ||||
1078 | # the exception now. | ||||
1079 | 2 | 2µs | $code .= "no warnings qw(exec);\n" if $call eq "CORE::exec"; | ||
1080 | |||||
1081 | 2 | 9µs | 2 | 152µs | my @protos = fill_protos($proto); # spent 152µs making 2 calls to Fatal::fill_protos, avg 76µs/call |
1082 | 2 | 18µs | 2 | 265µs | $code .= $class->_write_invocation($core, $call, $name, $void, $lexical, $sub, $sref, @protos); # spent 265µs making 2 calls to Fatal::_write_invocation, avg 133µs/call |
1083 | 2 | 2µs | $code .= "}\n"; | ||
1084 | 2 | 2µs | warn $code if $Debug; | ||
1085 | |||||
1086 | # I thought that changing package was a monumental waste of | ||||
1087 | # time for CORE subs, since they'll always be the same. However | ||||
1088 | # that's not the case, since they may refer to package-based | ||||
1089 | # filehandles (eg, with open). | ||||
1090 | # | ||||
1091 | # There is potential to more aggressively cache core subs | ||||
1092 | # that we know will never want to interact with package variables | ||||
1093 | # and filehandles. | ||||
1094 | |||||
1095 | { | ||||
1096 | 4 | 546µs | 2 | 60µs | # spent 36µs (12+24) within Fatal::BEGIN@1096 which was called:
# once (12µs+24µs) by autodie::BEGIN@6 at line 1096 # spent 36µs making 1 call to Fatal::BEGIN@1096
# spent 24µs making 1 call to strict::unimport |
1097 | |||||
1098 | 2 | 2µs | my $E; | ||
1099 | |||||
1100 | { | ||||
1101 | 4 | 6µs | local $@; | ||
1102 | 2 | 173µs | $code = eval("package $pkg; require Carp; $code"); ## no critic # spent 596µs executing statements in string eval # includes 72µs spent executing 4 calls to 4 subs defined therein. # spent 267µs executing statements in string eval # includes 27µs spent executing 2 calls to 3 subs defined therein. | ||
1103 | 2 | 3µs | $E = $@; | ||
1104 | } | ||||
1105 | |||||
1106 | 2 | 2µs | if (not $code) { | ||
1107 | croak("Internal error in autodie/Fatal processing $true_name: $E"); | ||||
1108 | |||||
1109 | } | ||||
1110 | } | ||||
1111 | |||||
1112 | # Now we need to wrap our fatalised sub inside an itty bitty | ||||
1113 | # closure, which can detect if we've leaked into another file. | ||||
1114 | # Luckily, we only need to do this for lexical (autodie) | ||||
1115 | # subs. Fatal subs can leak all they want, it's considered | ||||
1116 | # a "feature" (or at least backwards compatible). | ||||
1117 | |||||
1118 | # TODO: Cache our leak guards! | ||||
1119 | |||||
1120 | # TODO: This is pretty hairy code. A lot more tests would | ||||
1121 | # be really nice for this. | ||||
1122 | |||||
1123 | 2 | 2µs | my $leak_guard; | ||
1124 | |||||
1125 | 2 | 4µs | if ($lexical) { | ||
1126 | |||||
1127 | 2 | 7µs | $leak_guard = qq< | ||
1128 | package $pkg; | ||||
1129 | |||||
1130 | sub$real_proto { | ||||
1131 | |||||
1132 | # If we're inside a string eval, we can end up with a | ||||
1133 | # whacky filename. The following code allows autodie | ||||
1134 | # to propagate correctly into string evals. | ||||
1135 | |||||
1136 | my \$caller_level = 0; | ||||
1137 | |||||
1138 | my \$caller; | ||||
1139 | |||||
1140 | while ( (\$caller = (caller \$caller_level)[1]) =~ m{^\\(eval \\d+\\)\$} ) { | ||||
1141 | |||||
1142 | # If our filename is actually an eval, and we | ||||
1143 | # reach it, then go to our autodying code immediatately. | ||||
1144 | |||||
1145 | goto &\$code if (\$caller eq \$filename); | ||||
1146 | \$caller_level++; | ||||
1147 | } | ||||
1148 | |||||
1149 | # We're now out of the eval stack. | ||||
1150 | |||||
1151 | # If we're called from the correct file, then use the | ||||
1152 | # autodying code. | ||||
1153 | goto &\$code if ((caller \$caller_level)[1] eq \$filename); | ||||
1154 | |||||
1155 | # Oh bother, we've leaked into another file. Call the | ||||
1156 | # original code. Note that \$sref may actually be a | ||||
1157 | # reference to a Fatalised version of a core built-in. | ||||
1158 | # That's okay, because Fatal *always* leaks between files. | ||||
1159 | |||||
1160 | goto &\$sref if \$sref; | ||||
1161 | >; | ||||
1162 | |||||
1163 | |||||
1164 | # If we're here, it must have been a core subroutine called. | ||||
1165 | # Warning: The following code may disturb some viewers. | ||||
1166 | |||||
1167 | # TODO: It should be possible to combine this with | ||||
1168 | # write_invocation(). | ||||
1169 | |||||
1170 | 2 | 5µs | foreach my $proto (@protos) { | ||
1171 | 5 | 6µs | local $" = ", "; # So @args is formatted correctly. | ||
1172 | 5 | 8µs | my ($count, @args) = @$proto; | ||
1173 | 5 | 19µs | $leak_guard .= qq< | ||
1174 | if (\@_ == $count) { | ||||
1175 | return $call(@args); | ||||
1176 | } | ||||
1177 | >; | ||||
1178 | } | ||||
1179 | |||||
1180 | 2 | 2µs | $leak_guard .= qq< Carp::croak("Internal error in Fatal/autodie. Leak-guard failure"); } >; | ||
1181 | |||||
1182 | # warn "$leak_guard\n"; | ||||
1183 | |||||
1184 | 2 | 1µs | my $E; | ||
1185 | { | ||||
1186 | 4 | 6µs | local $@; | ||
1187 | |||||
1188 | 2 | 291µs | $leak_guard = eval $leak_guard; ## no critic # spent 39µs executing statements in string eval # includes 27µs spent executing 1 call to 1 sub defined therein. # spent 5µs executing statements in string eval | ||
1189 | |||||
1190 | 2 | 3µs | $E = $@; | ||
1191 | } | ||||
1192 | |||||
1193 | 2 | 3µs | die "Internal error in $class: Leak-guard installation failure: $E" if $E; | ||
1194 | } | ||||
1195 | |||||
1196 | 2 | 2µs | my $installed_sub = $leak_guard || $code; | ||
1197 | |||||
1198 | 2 | 15µs | 2 | 81µs | $class->_install_subs($pkg, { $name => $installed_sub }); # spent 81µs making 2 calls to Fatal::_install_subs, avg 40µs/call |
1199 | |||||
1200 | 2 | 4µs | $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical} = $installed_sub; | ||
1201 | |||||
1202 | # Cache that we've now overriddent this sub. If we get called | ||||
1203 | # again, we may need to find that find subroutine again (eg, for hints). | ||||
1204 | |||||
1205 | 2 | 14µs | 2 | 32µs | $Is_fatalised_sub{$installed_sub} = $sref; # spent 32µs making 2 calls to Tie::RefHash::STORE, avg 16µs/call |
1206 | |||||
1207 | 2 | 10µs | return $sref; | ||
1208 | |||||
1209 | } | ||||
1210 | |||||
1211 | # This subroutine exists primarily so that child classes can override | ||||
1212 | # it to point to their own exception class. Doing this is significantly | ||||
1213 | # less complex than overriding throw() | ||||
1214 | |||||
1215 | sub exception_class { return "autodie::exception" }; | ||||
1216 | |||||
1217 | { | ||||
1218 | 2 | 2µs | my %exception_class_for; | ||
1219 | 1 | 700ns | my %class_loaded; | ||
1220 | |||||
1221 | sub throw { | ||||
1222 | my ($class, @args) = @_; | ||||
1223 | |||||
1224 | # Find our exception class if we need it. | ||||
1225 | my $exception_class = | ||||
1226 | $exception_class_for{$class} ||= $class->exception_class; | ||||
1227 | |||||
1228 | if (not $class_loaded{$exception_class}) { | ||||
1229 | if ($exception_class =~ /[^\w:']/) { | ||||
1230 | confess "Bad exception class '$exception_class'.\nThe '$class->exception_class' method wants to use $exception_class\nfor exceptions, but it contains characters which are not word-characters or colons."; | ||||
1231 | } | ||||
1232 | |||||
1233 | # Alas, Perl does turn barewords into modules unless they're | ||||
1234 | # actually barewords. As such, we're left doing a string eval | ||||
1235 | # to make sure we load our file correctly. | ||||
1236 | |||||
1237 | my $E; | ||||
1238 | |||||
1239 | { | ||||
1240 | local $@; # We can't clobber $@, it's wrong! | ||||
1241 | eval "require $exception_class"; ## no critic | ||||
1242 | $E = $@; # Save $E despite ending our local. | ||||
1243 | } | ||||
1244 | |||||
1245 | # We need quotes around $@ to make sure it's stringified | ||||
1246 | # while still in scope. Without them, we run the risk of | ||||
1247 | # $@ having been cleared by us exiting the local() block. | ||||
1248 | |||||
1249 | confess "Failed to load '$exception_class'.\nThis may be a typo in the '$class->exception_class' method,\nor the '$exception_class' module may not exist.\n\n $E" if $E; | ||||
1250 | |||||
1251 | $class_loaded{$exception_class}++; | ||||
1252 | |||||
1253 | } | ||||
1254 | |||||
1255 | return $exception_class->new(@args); | ||||
1256 | } | ||||
1257 | } | ||||
1258 | |||||
1259 | # For some reason, dying while replacing our subs doesn't | ||||
1260 | # kill our calling program. It simply stops the loading of | ||||
1261 | # autodie and keeps going with everything else. The _autocroak | ||||
1262 | # sub allows us to die with a vegence. It should *only* ever be | ||||
1263 | # used for serious internal errors, since the results of it can't | ||||
1264 | # be captured. | ||||
1265 | |||||
1266 | sub _autocroak { | ||||
1267 | warn Carp::longmess(@_); | ||||
1268 | exit(255); # Ugh! | ||||
1269 | } | ||||
1270 | |||||
1271 | package autodie::Scope::Guard; | ||||
1272 | |||||
1273 | # This code schedules the cleanup of subroutines at the end of | ||||
1274 | # scope. It's directly inspired by chocolateboy's excellent | ||||
1275 | # Scope::Guard module. | ||||
1276 | |||||
1277 | # spent 9µs within autodie::Scope::Guard::new which was called:
# once (9µs+0s) by Fatal::import at line 324 | ||||
1278 | 1 | 2µs | my ($class, $handler) = @_; | ||
1279 | |||||
1280 | 1 | 8µs | return bless $handler, $class; | ||
1281 | } | ||||
1282 | |||||
1283 | sub DESTROY { | ||||
1284 | my ($self) = @_; | ||||
1285 | |||||
1286 | $self->(); | ||||
1287 | } | ||||
1288 | |||||
1289 | 1 | 23µs | 1; | ||
1290 | |||||
1291 | __END__ | ||||
# spent 30µs within Fatal::CORE:match which was called 18 times, avg 2µs/call:
# 7 times (11µs+0s) by Fatal::fill_protos at line 502, avg 2µs/call
# 4 times (6µs+0s) by Fatal::_write_invocation at line 554, avg 2µs/call
# 2 times (4µs+0s) by Fatal::_make_fatal at line 927, avg 2µs/call
# 2 times (3µs+0s) by Fatal::import at line 276, avg 1µs/call
# 2 times (2µs+0s) by Fatal::_make_fatal at line 911, avg 1µs/call
# once (4µs+0s) by autodie::BEGIN@6 at line 58 | |||||
# spent 37µs within Fatal::CORE:subst which was called 21 times, avg 2µs/call:
# 6 times (10µs+0s) by Fatal::fill_protos at line 506, avg 2µs/call
# 6 times (7µs+0s) by Fatal::fill_protos at line 505, avg 1µs/call
# 3 times (7µs+0s) by Fatal::fill_protos at line 507, avg 2µs/call
# 2 times (6µs+0s) by Fatal::_make_fatal at line 924, avg 3µs/call
# 2 times (4µs+0s) by Fatal::fill_protos at line 508, avg 2µs/call
# 2 times (3µs+0s) by Fatal::import at line 256, avg 2µs/call |