← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/usr/lib/x86_64-linux-gnu/perl-base/re.pm
StatementsExecuted 36 statements in 1.12ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1119µs11µsre::::BEGIN@4re::BEGIN@4
1114µs4µsre::::bitsre::bits
1114µs22µsre::::BEGIN@5re::BEGIN@5
1113µs8µsre::::importre::import
0000s0sre::::_load_unloadre::_load_unload
0000s0sre::::setcolorre::setcolor
0000s0sre::::unimportre::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package re;
2
3# pragma for controlling the regexp engine
4220µs213µs
# spent 11µs (9+2) within re::BEGIN@4 which was called: # once (9µs+2µs) by File::Slurp::BEGIN@128 at line 4
use strict;
# spent 11µs making 1 call to re::BEGIN@4 # spent 2µs making 1 call to strict::import
52909µs241µs
# spent 22µs (4+18) within re::BEGIN@5 which was called: # once (4µs+18µs) by File::Slurp::BEGIN@128 at line 5
use warnings;
# spent 22µs making 1 call to re::BEGIN@5 # spent 18µs making 1 call to warnings::import
6
71300nsour $VERSION = "0.43";
817µsour @ISA = qw(Exporter);
91600nsour @EXPORT_OK = qw{
10 is_regexp regexp_pattern
11 regname regnames regnames_count
12 regmust optimization
13};
1413µsour %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
15
161800nsmy %bitmask = (
17 taint => 0x00100000, # HINT_RE_TAINT
18 eval => 0x00200000, # HINT_RE_EVAL
19);
20
211100nsmy $flags_hint = 0x02000000; # HINT_RE_FLAGS
221100nsmy $PMMOD_SHIFT = 0;
2314µsmy %reflags = (
24 m => 1 << ($PMMOD_SHIFT + 0),
25 s => 1 << ($PMMOD_SHIFT + 1),
26 i => 1 << ($PMMOD_SHIFT + 2),
27 x => 1 << ($PMMOD_SHIFT + 3),
28 xx => 1 << ($PMMOD_SHIFT + 4),
29 n => 1 << ($PMMOD_SHIFT + 5),
30 p => 1 << ($PMMOD_SHIFT + 6),
31 strict => 1 << ($PMMOD_SHIFT + 10),
32# special cases:
33 d => 0,
34 l => 1,
35 u => 2,
36 a => 3,
37 aa => 4,
38);
39
40sub setcolor {
41 eval { # Ignore errors
42 require Term::Cap;
43
44 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
45 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
46 my @props = split /,/, $props;
47 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
48
49 $colors =~ s/\0//g;
50 $ENV{PERL_RE_COLORS} = $colors;
51 };
52 if ($@) {
53 $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
54 }
55
56}
57
5813µsmy %flags = (
59 COMPILE => 0x0000FF,
60 PARSE => 0x000001,
61 OPTIMISE => 0x000002,
62 TRIEC => 0x000004,
63 DUMP => 0x000008,
64 FLAGS => 0x000010,
65 TEST => 0x000020,
66
67 EXECUTE => 0x00FF00,
68 INTUIT => 0x000100,
69 MATCH => 0x000200,
70 TRIEE => 0x000400,
71
72 EXTRA => 0x3FF0000,
73 TRIEM => 0x0010000,
74 STATE => 0x0080000,
75 OPTIMISEM => 0x0100000,
76 STACK => 0x0280000,
77 BUFFERS => 0x0400000,
78 GPOS => 0x0800000,
79 DUMP_PRE_OPTIMIZE => 0x1000000,
80 WILDCARD => 0x2000000,
81);
82$flags{ALL} = -1 & ~($flags{BUFFERS}
83 |$flags{DUMP_PRE_OPTIMIZE}
84 |$flags{WILDCARD}
851900ns );
8611µs$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
871400ns$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
88$flags{More} = $flags{MORE} =
891400ns $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
901300ns$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
911100ns$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
92
931500nsif (defined &DynaLoader::boot_DynaLoader) {
941300ns require XSLoader;
951140µs1136µs XSLoader::load();
# spent 136µs making 1 call to XSLoader::load
96}
97# else we're miniperl
98# We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
99# uses re 'taint'.
100
101sub _load_unload {
102 my ($on)= @_;
103 if ($on) {
104 # We call install() every time, as if we didn't, we wouldn't
105 # "see" any changes to the color environment var since
106 # the last time it was called.
107
108 # install() returns an integer, which if casted properly
109 # in C resolves to a structure containing the regexp
110 # hooks. Setting it to a random integer will guarantee
111 # segfaults.
112 $^H{regcomp} = install();
113 } else {
114 delete $^H{regcomp};
115 }
116}
117
118
# spent 4µs within re::bits which was called: # once (4µs+0s) by re::import at line 301
sub bits {
1191100ns my $on = shift;
1201200ns my $bits = 0;
1211300ns my $turning_all_off = ! @_ && ! $on;
1221100ns my $seen_Debug = 0;
1231100ns my $seen_debug = 0;
1241100ns if ($turning_all_off) {
125
126 # Pretend were called with certain parameters, which are best dealt
127 # with that way.
128 push @_, keys %bitmask; # taint and eval
129 push @_, 'strict';
130 }
131
132 # Process each subpragma parameter
133 ARG:
13411µs foreach my $idx (0..$#_){
1351400ns my $s=$_[$idx];
13611µs if ($s eq 'Debug' or $s eq 'Debugcolor') {
137 if (! $seen_Debug) {
138 $seen_Debug = 1;
139
140 # Reset to nothing, and then add what follows. $seen_Debug
141 # allows, though unlikely someone would do it, more than one
142 # Debug and flags in the arguments
143 ${^RE_DEBUG_FLAGS} = 0;
144 }
145 setcolor() if $s =~/color/i;
146 for my $idx ($idx+1..$#_) {
147 if ($flags{$_[$idx]}) {
148 if ($on) {
149 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
150 } else {
151 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
152 }
153 } else {
154 require Carp;
155 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
156 join(", ",sort keys %flags ) );
157 }
158 }
159 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
160 last;
161 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
162
163 # These default flags should be kept in sync with the same values
164 # in regcomp.h
165 ${^RE_DEBUG_FLAGS} = $flags{'EXECUTE'} | $flags{'DUMP'};
166 setcolor() if $s =~/color/i;
167 _load_unload($on);
168 $seen_debug = 1;
169 } elsif (exists $bitmask{$s}) {
170 $bits |= $bitmask{$s};
171 } elsif ($EXPORT_OK{$s}) {
172 require Exporter;
173 re->export_to_level(2, 're', $s);
174 } elsif ($s eq 'strict') {
175 if ($on) {
176 $^H{reflags} |= $reflags{$s};
177 warnings::warnif('experimental::re_strict',
178 "\"use re 'strict'\" is experimental");
179
180 # Turn on warnings if not already done.
181 if (! warnings::enabled('regexp')) {
182 require warnings;
183 warnings->import('regexp');
184 $^H{re_strict} = 1;
185 }
186 }
187 else {
188 $^H{reflags} &= ~$reflags{$s} if $^H{reflags};
189
190 # Turn off warnings if we turned them on.
191 warnings->unimport('regexp') if $^H{re_strict};
192 }
193 if ($^H{reflags}) {
194 $^H |= $flags_hint;
195 }
196 else {
197 $^H &= ~$flags_hint;
198 }
199 } elsif ($s =~ s/^\///) {
200 my $reflags = $^H{reflags} || 0;
201 my $seen_charset;
202 my $x_count = 0;
203 while ($s =~ m/( . )/gx) {
204 local $_ = $1;
205 if (/[adul]/) {
206 # The 'a' may be repeated; hide this from the rest of the
207 # code by counting and getting rid of all of them, then
208 # changing to 'aa' if there is a repeat.
209 if ($_ eq 'a') {
210 my $sav_pos = pos $s;
211 my $a_count = $s =~ s/a//g;
212 pos $s = $sav_pos - 1; # -1 because got rid of the 'a'
213 if ($a_count > 2) {
214 require Carp;
215 Carp::carp(
216 qq 'The "a" flag may only appear a maximum of twice'
217 );
218 }
219 elsif ($a_count == 2) {
220 $_ = 'aa';
221 }
222 }
223 if ($on) {
224 if ($seen_charset) {
225 require Carp;
226 if ($seen_charset ne $_) {
227 Carp::carp(
228 qq 'The "$seen_charset" and "$_" flags '
229 .qq 'are exclusive'
230 );
231 }
232 else {
233 Carp::carp(
234 qq 'The "$seen_charset" flag may not appear '
235 .qq 'twice'
236 );
237 }
238 }
239 $^H{reflags_charset} = $reflags{$_};
240 $seen_charset = $_;
241 }
242 else {
243 delete $^H{reflags_charset}
244 if defined $^H{reflags_charset}
245 && $^H{reflags_charset} == $reflags{$_};
246 }
247 } elsif (exists $reflags{$_}) {
248 if ($_ eq 'x') {
249 $x_count++;
250 if ($x_count > 2) {
251 require Carp;
252 Carp::carp(
253 qq 'The "x" flag may only appear a maximum of twice'
254 );
255 }
256 elsif ($x_count == 2) {
257 $_ = 'xx'; # First time through got the /x
258 }
259 }
260
261 $on
262 ? $reflags |= $reflags{$_}
263 : ($reflags &= ~$reflags{$_});
264 } else {
265 require Carp;
266 Carp::carp(
267 qq'Unknown regular expression flag "$_"'
268 );
269 next ARG;
270 }
271 }
272 ($^H{reflags} = $reflags or defined $^H{reflags_charset})
273 ? $^H |= $flags_hint
274 : ($^H &= ~$flags_hint);
275 } else {
276 require Carp;
277 if ($seen_debug && defined $flags{$s}) {
278 Carp::carp("Use \"Debug\" not \"debug\", to list debug types"
279 . " in \"re\". \"$s\" ignored");
280 }
281 else {
282 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
283 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
284 ")");
285 }
286 }
287 }
288
28910s if ($turning_all_off) {
290 _load_unload(0);
291 $^H{reflags} = 0;
292 $^H{reflags_charset} = 0;
293 $^H &= ~$flags_hint;
294 }
295
29612µs $bits;
297}
298
299
# spent 8µs (3+4) within re::import which was called: # once (3µs+4µs) by File::Slurp::BEGIN@128 at line 128 of File/Slurp.pm
sub import {
3001100ns shift;
30112µs14µs $^H |= bits(1, @_);
# spent 4µs making 1 call to re::bits
302}
303
304sub unimport {
305 shift;
306 $^H &= ~ bits(0, @_);
307}
308
309115µs1;
310
311__END__
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.