← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:08 2010

File /usr/lib/perl/5.10/re.pm
Statements Executed 39
Total Time 0.0011968 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21132µs32µsre::::bitsre::bits
22220µs53µsre::::importre::import
0000s0sre::::BEGINre::BEGIN
0000s0sre::::_do_installre::_do_install
0000s0sre::::_load_unloadre::_load_unload
0000s0sre::::setcolorre::setcolor
0000s0sre::::unimportre::unimport
LineStmts.Exclusive
Time
Avg.Code
1package re;
2
3# pragma for controlling the regex engine
4332µs10µsuse strict;
# spent 12µs making 1 call to strict::import
531.05ms351µsuse warnings;
# spent 24µs making 1 call to warnings::import
6
71700ns700nsour $VERSION = "0.08";
819µs9µsour @ISA = qw(Exporter);
912µs2µsour @EXPORT_OK = qw(is_regexp regexp_pattern regmust
10 regname regnames regnames_count);
11113µs13µsour %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
12
13# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
14#
15# If you modify these values see comment below!
16
1712µs2µsmy %bitmask = (
18 taint => 0x00100000, # HINT_RE_TAINT
19 eval => 0x00200000, # HINT_RE_EVAL
20);
21
22# - File::Basename contains a literal for 'taint' as a fallback. If
23# taint is changed here, File::Basename must be updated as well.
24#
25# - ExtUtils::ParseXS uses a hardcoded
26# BEGIN { $^H |= 0x00200000 }
27# in it to allow re.xs to be built. So if 'eval' is changed here then
28# ExtUtils::ParseXS must be changed as well.
29#
30# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
31
32sub setcolor {
33 eval { # Ignore errors
34 require Term::Cap;
35
36 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
37 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
38 my @props = split /,/, $props;
39 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
40
41 $colors =~ s/\0//g;
42 $ENV{PERL_RE_COLORS} = $colors;
43 };
44 if ($@) {
45 $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
46 }
47
48}
49
5018µs8µsmy %flags = (
51 COMPILE => 0x0000FF,
52 PARSE => 0x000001,
53 OPTIMISE => 0x000002,
54 TRIEC => 0x000004,
55 DUMP => 0x000008,
56 FLAGS => 0x000010,
57
58 EXECUTE => 0x00FF00,
59 INTUIT => 0x000100,
60 MATCH => 0x000200,
61 TRIEE => 0x000400,
62
63 EXTRA => 0xFF0000,
64 TRIEM => 0x010000,
65 OFFSETS => 0x020000,
66 OFFSETSDBG => 0x040000,
67 STATE => 0x080000,
68 OPTIMISEM => 0x100000,
69 STACK => 0x280000,
70 BUFFERS => 0x400000,
71);
7212µs2µs$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
7311µs1µs$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
7411µs1µs$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE};
7512µs2µs$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
7611µs1µs$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
7711µs1µs$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
78
791200ns200nsmy $installed;
801200ns200nsmy $installed_error;
81
82sub _do_install {
83 if ( ! defined($installed) ) {
84 require XSLoader;
85 $installed = eval { XSLoader::load('re', $VERSION) } || 0;
86 $installed_error = $@;
87 }
88}
89
90sub _load_unload {
91 my ($on)= @_;
92 if ($on) {
93 _do_install();
94 if ( ! $installed ) {
95 die "'re' not installed!? ($installed_error)";
96 } else {
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 regex
103 # hooks. Setting it to a random integer will guarantee
104 # segfaults.
105 $^H{regcomp} = install();
106 }
107 } else {
108 delete $^H{regcomp};
109 }
110}
111
112
# spent 32µs within re::bits which was called 2 times, avg 16µs/call: # 2 times (32µs+0s) by re::import at line 161, avg 16µs/call
sub bits {
1131425µs2µs my $on = shift;
114 my $bits = 0;
115 unless (@_) {
116 require Carp;
117 Carp::carp("Useless use of \"re\" pragma");
118 }
119 foreach my $idx (0..$#_){
120 my $s=$_[$idx];
121 if ($s eq 'Debug' or $s eq 'Debugcolor') {
122 setcolor() if $s =~/color/i;
123 ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
124 for my $idx ($idx+1..$#_) {
125 if ($flags{$_[$idx]}) {
126 if ($on) {
127 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
128 } else {
129 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
130 }
131 } else {
132 require Carp;
133 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
134 join(", ",sort keys %flags ) );
135 }
136 }
137 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
138 last;
139 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
140 setcolor() if $s =~/color/i;
141 _load_unload($on);
142 last;
143 } elsif (exists $bitmask{$s}) {
144 $bits |= $bitmask{$s};
145 } elsif ($EXPORT_OK{$s}) {
146 _do_install();
147 require Exporter;
148 re->export_to_level(2, 're', $s);
149 } else {
150 require Carp;
151 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
152 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
153 ")");
154 }
155 }
156 $bits;
157}
158
159
# spent 53µs (20+32) within re::import which was called 2 times, avg 26µs/call: # once (10µs+18µs) at line 46 of /usr/share/perl/5.10/File/Basename.pm # once (10µs+15µs) at line 596 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm
sub import {
160416µs4µs shift;
161 $^H |= bits(1, @_);
# spent 32µs making 2 calls to re::bits, avg 16µs/call
162}
163
164sub unimport {
165 shift;
166 $^H &= ~ bits(0, @_);
167}
168
169128µs28µs1;
170
171__END__
172