← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:34 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/feature.pm
StatementsExecuted 656 statements in 1.32ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
252525987µs1.23msfeature::::importfeature::import
2511181µs181µsfeature::::CORE:substfeature::CORE:subst (opcode)
501162µs62µsfeature::::CORE:substcontfeature::CORE:substcont (opcode)
0000s0sfeature::::croakfeature::croak
0000s0sfeature::::unimportfeature::unimport
0000s0sfeature::::unknown_featurefeature::unknown_feature
0000s0sfeature::::unknown_feature_bundlefeature::unknown_feature_bundle
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package feature;
2
31400nsour $VERSION = '1.16';
4
5# (feature name) => (internal name, used in %^H)
612µsmy %feature = (
7 switch => 'feature_switch',
8 say => "feature_say",
9 state => "feature_state",
10 unicode_strings => "feature_unicode",
11);
12
13# This gets set (for now) in $^H as well as in %^H,
14# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
15# See HINT_UNI_8_BIT in perl.h.
161200nsour $hint_uni8bit = 0x00000800;
17
18# NB. the latest bundle must be loaded by the -E switch (see toke.c)
19
2014µsmy %feature_bundle = (
21 "5.10" => [qw(switch say state)],
22 "5.11" => [qw(switch say state unicode_strings)],
23 "5.12" => [qw(switch say state unicode_strings)],
24);
25
26# special case
271700ns$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
28
29# TODO:
30# - think about versioned features (use feature switch => 2)
31
32=head1 NAME
33
34feature - Perl pragma to enable new features
35
36=head1 SYNOPSIS
37
38 use feature qw(switch say);
39 given ($foo) {
40 when (1) { say "\$foo == 1" }
41 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
42 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
43 when ($_ > 100) { say "\$foo > 100" }
44 default { say "None of the above" }
45 }
46
47 use feature ':5.10'; # loads all features available in perl 5.10
48
49=head1 DESCRIPTION
50
51It is usually impossible to add new syntax to Perl without breaking
52some existing programs. This pragma provides a way to minimize that
53risk. New syntactic constructs, or new semantic meanings to older
54constructs, can be enabled by C<use feature 'foo'>, and will be parsed
55only when the appropriate feature pragma is in scope.
56
57=head2 Lexical effect
58
59Like other pragmas (C<use strict>, for example), features have a lexical
60effect. C<use feature qw(foo)> will only make the feature "foo" available
61from that point to the end of the enclosing block.
62
63 {
64 use feature 'say';
65 say "say is available here";
66 }
67 print "But not here.\n";
68
69=head2 C<no feature>
70
71Features can also be turned off by using C<no feature "foo">. This too
72has lexical effect.
73
74 use feature 'say';
75 say "say is available here";
76 {
77 no feature 'say';
78 print "But not here.\n";
79 }
80 say "Yet it is here.";
81
82C<no feature> with no features specified will turn off all features.
83
84=head2 The 'switch' feature
85
86C<use feature 'switch'> tells the compiler to enable the Perl 6
87given/when construct.
88
89See L<perlsyn/"Switch statements"> for details.
90
91=head2 The 'say' feature
92
93C<use feature 'say'> tells the compiler to enable the Perl 6
94C<say> function.
95
96See L<perlfunc/say> for details.
97
98=head2 the 'state' feature
99
100C<use feature 'state'> tells the compiler to enable C<state>
101variables.
102
103See L<perlsub/"Persistent Private Variables"> for details.
104
105=head2 the 'unicode_strings' feature
106
107C<use feature 'unicode_strings'> tells the compiler to treat
108all strings outside of C<use locale> and C<use bytes> as Unicode. It is
109available starting with Perl 5.11.3.
110
111See L<perlunicode/The "Unicode Bug"> for details.
112
113=head1 FEATURE BUNDLES
114
115It's possible to load a whole slew of features in one go, using
116a I<feature bundle>. The name of a feature bundle is prefixed with
117a colon, to distinguish it from an actual feature. At present, the
118only feature bundle is C<use feature ":5.10"> which is equivalent
119to C<use feature qw(switch say state)>.
120
121Specifying sub-versions such as the C<0> in C<5.10.0> in feature bundles has
122no effect: feature bundles are guaranteed to be the same for all sub-versions.
123
124=head1 IMPLICIT LOADING
125
126There are two ways to load the C<feature> pragma implicitly :
127
128=over 4
129
130=item *
131
132By using the C<-E> switch on the command-line instead of C<-e>. It enables
133all available features in the main compilation unit (that is, the one-liner.)
134
135=item *
136
137By requiring explicitly a minimal Perl version number for your program, with
138the C<use VERSION> construct, and when the version is higher than or equal to
1395.10.0. That is,
140
141 use 5.10.0;
142
143will do an implicit
144
145 use feature ':5.10';
146
147and so on. Note how the trailing sub-version is automatically stripped from the
148version.
149
150But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
151
152 use 5.010;
153
154with the same effect.
155
156=back
157
158=cut
159
160
# spent 1.23ms (987µs+243µs) within feature::import which was called 25 times, avg 49µs/call: # once (86µs+21µs) by Tapper::MCP::Scheduler::PrioQueue::BEGIN@5.8 at line 5 of lib/Tapper/MCP/Scheduler/PrioQueue.pm # once (77µs+7µs) by Tapper::Schema::TestrunDB::Result::Testrun::BEGIN@9.21 at line 9 of Tapper/Schema/TestrunDB/Result/Testrun.pm # once (52µs+8µs) by Tapper::Schema::ReportsDB::Result::Tap::BEGIN@9.29 at line 9 of Tapper/Schema/ReportsDB/Result/Tap.pm # once (52µs+7µs) by Tapper::Schema::ReportsDB::Result::View020TestrunOverview::BEGIN@10.30 at line 10 of Tapper/Schema/ReportsDB/Result/View020TestrunOverview.pm # once (38µs+15µs) by Tapper::Schema::TestrunDB::BEGIN@6.17 at line 6 of Tapper/Schema/TestrunDB.pm # once (36µs+15µs) by Tapper::MCP::Scheduler::Controller::BEGIN@5.1 at line 5 of lib/Tapper/MCP/Scheduler/Controller.pm # once (36µs+13µs) by Tapper::Schema::TestrunDB::Result::Scenario::BEGIN@9.19 at line 9 of Tapper/Schema/TestrunDB/Result/Scenario.pm # once (37µs+12µs) by Tapper::Schema::TestrunDB::ResultSet::Host::BEGIN@9.25 at line 9 of Tapper/Schema/TestrunDB/ResultSet/Host.pm # once (36µs+13µs) by Tapper::Schema::ReportsDB::BEGIN@6.26 at line 6 of Tapper/Schema/ReportsDB.pm # once (37µs+10µs) by Tapper::Schema::TestrunDB::ResultSet::TestrunScheduling::BEGIN@9.23 at line 9 of Tapper/Schema/TestrunDB/ResultSet/TestrunScheduling.pm # once (33µs+12µs) by Tapper::Model::BEGIN@13.3 at line 13 of Tapper/Model.pm # once (36µs+9µs) by Tapper::Schema::ReportsDB::Result::Report::BEGIN@9.32 at line 9 of Tapper/Schema/ReportsDB/Result/Report.pm # once (36µs+8µs) by Tapper::Schema::ReportsDB::Result::View010TestrunOverviewReports::BEGIN@10.28 at line 10 of Tapper/Schema/ReportsDB/Result/View010TestrunOverviewReports.pm # once (37µs+6µs) by Tapper::MCP::Net::TAP::BEGIN@3.13 at line 3 of lib/Tapper/MCP/Net/TAP.pm # once (33µs+10µs) by Tapper::MCP::Scheduler::Algorithm::WFQ::BEGIN@6.16 at line 6 of lib/Tapper/MCP/Scheduler/Algorithm/WFQ.pm # once (35µs+8µs) by Tapper::Schema::ReportsDB::Result::ReportgroupTestrun::BEGIN@9.27 at line 9 of Tapper/Schema/ReportsDB/Result/ReportgroupTestrun.pm # once (33µs+9µs) by Tapper::Base::BEGIN@16.2 at line 16 of Tapper/Base.pm # once (35µs+7µs) by Tapper::Schema::TestrunDB::Result::ScenarioElement::BEGIN@9.20 at line 9 of Tapper/Schema/TestrunDB/Result/ScenarioElement.pm # once (33µs+9µs) by Tapper::Config::BEGIN@10.4 at line 10 of Tapper/Config.pm # once (35µs+7µs) by Tapper::Schema::TestrunDB::Result::HostFeature::BEGIN@9.18 at line 9 of Tapper/Schema/TestrunDB/Result/HostFeature.pm # once (34µs+7µs) by Tapper::Schema::TestrunDB::Result::Host::BEGIN@9.22 at line 9 of Tapper/Schema/TestrunDB/Result/Host.pm # once (34µs+7µs) by Tapper::MCP::Net::BEGIN@7.9 at line 7 of lib/Tapper/MCP/Net.pm # once (31µs+8µs) by Tapper::Schema::ReportsDB::Result::ReportgroupTestrunStats::BEGIN@9.31 at line 9 of Tapper/Schema/ReportsDB/Result/ReportgroupTestrunStats.pm # once (31µs+9µs) by Tapper::MCP::Scheduler::Algorithm::BEGIN@5.5 at line 5 of lib/Tapper/MCP/Scheduler/Algorithm.pm # once (22µs+4µs) by Tapper::Schema::TestrunDB::ResultSet::Queue::BEGIN@9.24 at line 9 of Tapper/Schema/TestrunDB/ResultSet/Queue.pm
sub import {
1616501.31ms my $class = shift;
162 if (@_ == 0) {
163 croak("No features specified");
164 }
165 while (@_) {
166 my $name = shift(@_);
167 if (substr($name, 0, 1) eq ":") {
168 my $v = substr($name, 1);
169 if (!exists $feature_bundle{$v}) {
17075243µs $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
# spent 181µs making 25 calls to feature::CORE:subst, avg 7µs/call # spent 62µs making 50 calls to feature::CORE:substcont, avg 1µs/call
171 if (!exists $feature_bundle{$v}) {
172 unknown_feature_bundle(substr($name, 1));
173 }
174 }
175 unshift @_, @{$feature_bundle{$v}};
176 next;
177 }
178 if (!exists $feature{$name}) {
179 unknown_feature($name);
180 }
181 $^H{$feature{$name}} = 1;
182 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
183 }
184}
185
186sub unimport {
187 my $class = shift;
188
189 # A bare C<no feature> should disable *all* features
190 if (!@_) {
191 delete @^H{ values(%feature) };
192 $^H &= ~ $hint_uni8bit;
193 return;
194 }
195
196 while (@_) {
197 my $name = shift;
198 if (substr($name, 0, 1) eq ":") {
199 my $v = substr($name, 1);
200 if (!exists $feature_bundle{$v}) {
201 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
202 if (!exists $feature_bundle{$v}) {
203 unknown_feature_bundle(substr($name, 1));
204 }
205 }
206 unshift @_, @{$feature_bundle{$v}};
207 next;
208 }
209 if (!exists($feature{$name})) {
210 unknown_feature($name);
211 }
212 else {
213 delete $^H{$feature{$name}};
214 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
215 }
216 }
217}
218
219sub unknown_feature {
220 my $feature = shift;
221 croak(sprintf('Feature "%s" is not supported by Perl %vd',
222 $feature, $^V));
223}
224
225sub unknown_feature_bundle {
226 my $feature = shift;
227 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
228 $feature, $^V));
229}
230
231sub croak {
232 require Carp;
233 Carp::croak(@_);
234}
235
23616µs1;
 
# spent 181µs within feature::CORE:subst which was called 25 times, avg 7µs/call: # 25 times (181µs+0s) by feature::import at line 170, avg 7µs/call
sub feature::CORE:subst; # opcode
# spent 62µs within feature::CORE:substcont which was called 50 times, avg 1µs/call: # 50 times (62µs+0s) by feature::import at line 170, avg 1µs/call
sub feature::CORE:substcont; # opcode