Profile of re.pm

← Index
NYTProf Performance Profile «line view»
For -e
Run on Thu Jun 30 16:34:56 2016
Reported on Thu Jun 30 16:35:08 2016

Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/5.22.1/x86_64-linux/re.pm
Statements | Executed 36 statements in 1.83ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 18µs | 21µs | re::::BEGIN@4re::BEGIN@4
1 | 1 | 1 | 12µs | 12µs | re::::bitsre::bits
1 | 1 | 1 | 8µs | 14µs | re::::BEGIN@5re::BEGIN@5
1 | 1 | 1 | 8µs | 20µs | re::::importre::import
0 | 0 | 0 | 0s | 0s | re::::_load_unloadre::_load_unload
0 | 0 | 0 | 0s | 0s | re::::setcolorre::setcolor
0 | 0 | 0 | 0s | 0s | re::::unimportre::unimport

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package re;
2 |  |  |  |  |
3 |  |  |  |  | # pragma for controlling the regexp engine
4 | 2 | 29µs | 2 | 24µs | # spent 21µs (18+3) within re::BEGIN@4 which was called: # once (18µs+3µs) by DateTime::Format::Alami::BEGIN@114 at line 4 use strict; # spent 21µs making 1 call to re::BEGIN@4 # spent 3µs making 1 call to strict::import
5 | 2 | 1.40ms | 2 | 19µs | # spent 14µs (8+5) within re::BEGIN@5 which was called: # once (8µs+5µs) by DateTime::Format::Alami::BEGIN@114 at line 5 use warnings; # spent 14µs making 1 call to re::BEGIN@5 # spent 5µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 1 | 600ns |  |  | our $VERSION = "0.32";
8 | 1 | 8µs |  |  | our @ISA = qw(Exporter);
9 | 1 | 1µs |  |  | our @EXPORT_OK = ('regmust',
10 |  |  |  |  | qw(is_regexp regexp_pattern
11 |  |  |  |  | regname regnames regnames_count));
12 | 1 | 6µs |  |  | our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
13 |  |  |  |  |
14 | 1 | 900ns |  |  | my %bitmask = (
15 |  |  |  |  | taint => 0x00100000, # HINT_RE_TAINT
16 |  |  |  |  | eval => 0x00200000, # HINT_RE_EVAL
17 |  |  |  |  | );
18 |  |  |  |  |
19 | 1 | 300ns |  |  | my $flags_hint = 0x02000000; # HINT_RE_FLAGS
20 | 1 | 100ns |  |  | my $PMMOD_SHIFT = 0;
21 | 1 | 6µs |  |  | my %reflags = (
22 |  |  |  |  | m => 1 << ($PMMOD_SHIFT + 0),
23 |  |  |  |  | s => 1 << ($PMMOD_SHIFT + 1),
24 |  |  |  |  | i => 1 << ($PMMOD_SHIFT + 2),
25 |  |  |  |  | x => 1 << ($PMMOD_SHIFT + 3),
26 |  |  |  |  | n => 1 << ($PMMOD_SHIFT + 5),
27 |  |  |  |  | p => 1 << ($PMMOD_SHIFT + 6),
28 |  |  |  |  | strict => 1 << ($PMMOD_SHIFT + 10),
29 |  |  |  |  | # special cases:
30 |  |  |  |  | d => 0,
31 |  |  |  |  | l => 1,
32 |  |  |  |  | u => 2,
33 |  |  |  |  | a => 3,
34 |  |  |  |  | aa => 4,
35 |  |  |  |  | );
36 |  |  |  |  |
37 |  |  |  |  | sub setcolor {
38 |  |  |  |  | eval { # Ignore errors
39 |  |  |  |  | require Term::Cap;
40 |  |  |  |  |
41 |  |  |  |  | my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
42 |  |  |  |  | my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
43 |  |  |  |  | my @props = split /,/, $props;
44 |  |  |  |  | my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
45 |  |  |  |  |
46 |  |  |  |  | $colors =~ s/\0//g;
47 |  |  |  |  | $ENV{PERL_RE_COLORS} = $colors;
48 |  |  |  |  | };
49 |  |  |  |  | if ($@) {
50 |  |  |  |  | $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
51 |  |  |  |  | }
52 |  |  |  |  |
53 |  |  |  |  | }
54 |  |  |  |  |
55 | 1 | 7µs |  |  | my %flags = (
56 |  |  |  |  | COMPILE => 0x0000FF,
57 |  |  |  |  | PARSE => 0x000001,
58 |  |  |  |  | OPTIMISE => 0x000002,
59 |  |  |  |  | TRIEC => 0x000004,
60 |  |  |  |  | DUMP => 0x000008,
61 |  |  |  |  | FLAGS => 0x000010,
62 |  |  |  |  | TEST => 0x000020,
63 |  |  |  |  |
64 |  |  |  |  | EXECUTE => 0x00FF00,
65 |  |  |  |  | INTUIT => 0x000100,
66 |  |  |  |  | MATCH => 0x000200,
67 |  |  |  |  | TRIEE => 0x000400,
68 |  |  |  |  |
69 |  |  |  |  | EXTRA => 0xFF0000,
70 |  |  |  |  | TRIEM => 0x010000,
71 |  |  |  |  | OFFSETS => 0x020000,
72 |  |  |  |  | OFFSETSDBG => 0x040000,
73 |  |  |  |  | STATE => 0x080000,
74 |  |  |  |  | OPTIMISEM => 0x100000,
75 |  |  |  |  | STACK => 0x280000,
76 |  |  |  |  | BUFFERS => 0x400000,
77 |  |  |  |  | GPOS => 0x800000,
78 |  |  |  |  | );
79 | 1 | 1µs |  |  | $flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
80 | 1 | 600ns |  |  | $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
81 | 1 | 500ns |  |  | $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
82 | 1 | 700ns |  |  | $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
83 | 1 | 400ns |  |  | $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
84 | 1 | 400ns |  |  | $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
85 |  |  |  |  |
86 | 1 | 800ns |  |  | if (defined &DynaLoader::boot_DynaLoader) {
87 | 1 | 600ns |  |  | require XSLoader;
88 | 1 | 320µs | 1 | 312µs | XSLoader::load(); # spent 312µs making 1 call to XSLoader::load
89 |  |  |  |  | }
90 |  |  |  |  | # else we're miniperl
91 |  |  |  |  | # We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
92 |  |  |  |  | # uses re 'taint'.
93 |  |  |  |  |
94 |  |  |  |  | sub _load_unload {
95 |  |  |  |  | my ($on)= @_;
96 |  |  |  |  | if ($on) {
97 |  |  |  |  | # We call install() every time, as if we didn't, we wouldn't
98 |  |  |  |  | # "see" any changes to the color environment var since
99 |  |  |  |  | # the last time it was called.
100 |  |  |  |  |
101 |  |  |  |  | # install() returns an integer, which if casted properly
102 |  |  |  |  | # in C resolves to a structure containing the regexp
103 |  |  |  |  | # hooks. Setting it to a random integer will guarantee
104 |  |  |  |  | # segfaults.
105 |  |  |  |  | $^H{regcomp} = install();
106 |  |  |  |  | } else {
107 |  |  |  |  | delete $^H{regcomp};
108 |  |  |  |  | }
109 |  |  |  |  | }
110 |  |  |  |  |
111 |  |  |  |  | # spent 12µs within re::bits which was called: # once (12µs+0s) by re::import at line 275 sub bits {
112 | 1 | 200ns |  |  | my $on = shift;
113 | 1 | 200ns |  |  | my $bits = 0;
114 | 1 | 700ns |  |  | my $turning_all_off = ! @_ && ! $on;
115 | 1 | 200ns |  |  | my %seen; # Has flag already been seen?
116 | 1 | 200ns |  |  | if ($turning_all_off) {
117 |  |  |  |  |
118 |  |  |  |  | # Pretend were called with certain parameters, which are best dealt
119 |  |  |  |  | # with that way.
120 |  |  |  |  | push @_, keys %bitmask; # taint and eval
121 |  |  |  |  | push @_, 'strict';
122 |  |  |  |  | }
123 |  |  |  |  |
124 |  |  |  |  | # Process each subpragma parameter
125 |  |  |  |  | ARG:
126 | 1 | 5µs |  |  | foreach my $idx (0..$#_){
127 | 1 | 700ns |  |  | my $s=$_[$idx];
128 | 1 | 2µs |  |  | if ($s eq 'Debug' or $s eq 'Debugcolor') {
129 |  |  |  |  | setcolor() if $s =~/color/i;
130 |  |  |  |  | ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
131 |  |  |  |  | for my $idx ($idx+1..$#_) {
132 |  |  |  |  | if ($flags{$_[$idx]}) {
133 |  |  |  |  | if ($on) {
134 |  |  |  |  | ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
135 |  |  |  |  | } else {
136 |  |  |  |  | ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
137 |  |  |  |  | }
138 |  |  |  |  | } else {
139 |  |  |  |  | require Carp;
140 |  |  |  |  | Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
141 |  |  |  |  | join(", ",sort keys %flags ) );
142 |  |  |  |  | }
143 |  |  |  |  | }
144 |  |  |  |  | _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
145 |  |  |  |  | last;
146 |  |  |  |  | } elsif ($s eq 'debug' or $s eq 'debugcolor') {
147 |  |  |  |  | setcolor() if $s =~/color/i;
148 |  |  |  |  | _load_unload($on);
149 |  |  |  |  | last;
150 |  |  |  |  | } elsif (exists $bitmask{$s}) {
151 |  |  |  |  | $bits |= $bitmask{$s};
152 |  |  |  |  | } elsif ($EXPORT_OK{$s}) {
153 |  |  |  |  | require Exporter;
154 |  |  |  |  | re->export_to_level(2, 're', $s);
155 |  |  |  |  | } elsif ($s eq 'strict') {
156 |  |  |  |  | if ($on) {
157 |  |  |  |  | $^H{reflags} |= $reflags{$s};
158 |  |  |  |  | warnings::warnif('experimental::re_strict',
159 |  |  |  |  | "\"use re 'strict'\" is experimental");
160 |  |  |  |  |
161 |  |  |  |  | # Turn on warnings if not already done.
162 |  |  |  |  | if (! warnings::enabled('regexp')) {
163 |  |  |  |  | require warnings;
164 |  |  |  |  | warnings->import('regexp');
165 |  |  |  |  | $^H{re_strict} = 1;
166 |  |  |  |  | }
167 |  |  |  |  | }
168 |  |  |  |  | else {
169 |  |  |  |  | $^H{reflags} &= ~$reflags{$s} if $^H{reflags};
170 |  |  |  |  |
171 |  |  |  |  | # Turn off warnings if we turned them on.
172 |  |  |  |  | warnings->unimport('regexp') if $^H{re_strict};
173 |  |  |  |  | }
174 |  |  |  |  | if ($^H{reflags}) {
175 |  |  |  |  | $^H |= $flags_hint;
176 |  |  |  |  | }
177 |  |  |  |  | else {
178 |  |  |  |  | $^H &= ~$flags_hint;
179 |  |  |  |  | }
180 |  |  |  |  | } elsif ($s =~ s/^\///) {
181 |  |  |  |  | my $reflags = $^H{reflags} || 0;
182 |  |  |  |  | my $seen_charset;
183 |  |  |  |  | while ($s =~ m/( . )/gx) {
184 |  |  |  |  | local $_ = $1;
185 |  |  |  |  | if (/[adul]/) {
186 |  |  |  |  | # The 'a' may be repeated; hide this from the rest of the
187 |  |  |  |  | # code by counting and getting rid of all of them, then
188 |  |  |  |  | # changing to 'aa' if there is a repeat.
189 |  |  |  |  | if ($_ eq 'a') {
190 |  |  |  |  | my $sav_pos = pos $s;
191 |  |  |  |  | my $a_count = $s =~ s/a//g;
192 |  |  |  |  | pos $s = $sav_pos - 1; # -1 because got rid of the 'a'
193 |  |  |  |  | if ($a_count > 2) {
194 |  |  |  |  | require Carp;
195 |  |  |  |  | Carp::carp(
196 |  |  |  |  | qq 'The "a" flag may only appear a maximum of twice'
197 |  |  |  |  | );
198 |  |  |  |  | }
199 |  |  |  |  | elsif ($a_count == 2) {
200 |  |  |  |  | $_ = 'aa';
201 |  |  |  |  | }
202 |  |  |  |  | }
203 |  |  |  |  | if ($on) {
204 |  |  |  |  | if ($seen_charset) {
205 |  |  |  |  | require Carp;
206 |  |  |  |  | if ($seen_charset ne $_) {
207 |  |  |  |  | Carp::carp(
208 |  |  |  |  | qq 'The "$seen_charset" and "$_" flags '
209 |  |  |  |  | .qq 'are exclusive'
210 |  |  |  |  | );
211 |  |  |  |  | }
212 |  |  |  |  | else {
213 |  |  |  |  | Carp::carp(
214 |  |  |  |  | qq 'The "$seen_charset" flag may not appear '
215 |  |  |  |  | .qq 'twice'
216 |  |  |  |  | );
217 |  |  |  |  | }
218 |  |  |  |  | }
219 |  |  |  |  | $^H{reflags_charset} = $reflags{$_};
220 |  |  |  |  | $seen_charset = $_;
221 |  |  |  |  | }
222 |  |  |  |  | else {
223 |  |  |  |  | delete $^H{reflags_charset}
224 |  |  |  |  | if defined $^H{reflags_charset}
225 |  |  |  |  | && $^H{reflags_charset} == $reflags{$_};
226 |  |  |  |  | }
227 |  |  |  |  | } elsif (exists $reflags{$_}) {
228 |  |  |  |  | $seen{$_}++;
229 |  |  |  |  | $on
230 |  |  |  |  | ? $reflags |= $reflags{$_}
231 |  |  |  |  | : ($reflags &= ~$reflags{$_});
232 |  |  |  |  | } else {
233 |  |  |  |  | require Carp;
234 |  |  |  |  | Carp::carp(
235 |  |  |  |  | qq'Unknown regular expression flag "$_"'
236 |  |  |  |  | );
237 |  |  |  |  | next ARG;
238 |  |  |  |  | }
239 |  |  |  |  | }
240 |  |  |  |  | ($^H{reflags} = $reflags or defined $^H{reflags_charset})
241 |  |  |  |  | ? $^H |= $flags_hint
242 |  |  |  |  | : ($^H &= ~$flags_hint);
243 |  |  |  |  | } else {
244 |  |  |  |  | require Carp;
245 |  |  |  |  | Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
246 |  |  |  |  | join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
247 |  |  |  |  | ")");
248 |  |  |  |  | }
249 |  |  |  |  | }
250 | 1 | 200ns |  |  | if (exists $seen{'x'} && $seen{'x'} > 1
251 |  |  |  |  | && (warnings::enabled("deprecated")
252 |  |  |  |  | || warnings::enabled("regexp")))
253 |  |  |  |  | {
254 |  |  |  |  | my $message = "Having more than one /x regexp modifier is deprecated";
255 |  |  |  |  | if (warnings::enabled("deprecated")) {
256 |  |  |  |  | warnings::warn("deprecated", $message);
257 |  |  |  |  | }
258 |  |  |  |  | else {
259 |  |  |  |  | warnings::warn("regexp", $message);
260 |  |  |  |  | }
261 |  |  |  |  | }
262 |  |  |  |  |
263 | 1 | 200ns |  |  | if ($turning_all_off) {
264 |  |  |  |  | _load_unload(0);
265 |  |  |  |  | $^H{reflags} = 0;
266 |  |  |  |  | $^H{reflags_charset} = 0;
267 |  |  |  |  | $^H &= ~$flags_hint;
268 |  |  |  |  | }
269 |  |  |  |  |
270 | 1 | 6µs |  |  | $bits;
271 |  |  |  |  | }
272 |  |  |  |  |
273 |  |  |  |  | # spent 20µs (8+12) within re::import which was called: # once (8µs+12µs) by DateTime::Format::Alami::BEGIN@114 at line 114 of lib/DateTime/Format/Alami.pm sub import {
274 | 1 | 200ns |  |  | shift;
275 | 1 | 5µs | 1 | 12µs | $^H |= bits(1, @_); # spent 12µs making 1 call to re::bits
276 |  |  |  |  | }
277 |  |  |  |  |
278 |  |  |  |  | sub unimport {
279 |  |  |  |  | shift;
280 |  |  |  |  | $^H &= ~ bits(0, @_);
281 |  |  |  |  | }
282 |  |  |  |  |
283 | 1 | 23µs |  |  | 1;
284 |  |  |  |  |
285 |  |  |  |  | __END__