Profile of feature.pm

Filename	/usr/share/perl/5.14/feature.pm
Statements	Executed 187 statements in 294µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
6	6	6	208µs	252µs	feature::::importfeature::import
6	1	1	32µs	32µs	feature::::CORE:substfeature::CORE:subst (opcode)
12	1	1	12µs	12µs	feature::::CORE:substcontfeature::CORE:substcont (opcode)
0	0	0	0s	0s	feature::::croakfeature::croak
0	0	0	0s	0s	feature::::unimportfeature::unimport
0	0	0	0s	0s	feature::::unknown_featurefeature::unknown_feature
0	0	0	0s	0s	feature::::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
1					package feature;
2
3	1	1µs			our $VERSION = '1.20';
4
5					# (feature name) => (internal name, used in %^H)
6	1	4µs			my %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.
16	1	400ns			our $hint_uni8bit = 0x00000800;
17
18					# NB. the latest bundle must be loaded by the -E switch (see toke.c)
19
20	1	11µs			my %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					"5.13" => [qw(switch say state unicode_strings)],
25					"5.14" => [qw(switch say state unicode_strings)],
26					);
27
28					# special case
29	1	1µs			$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
30
31					# TODO:
32					# - think about versioned features (use feature switch => 2)
33
34					# spent 252µs (208+43) within feature::import which was called 6 times, avg 42µs/call: # once (78µs+15µs) by main::BEGIN@7.1 at line 7 of testnewboardincnply # once (42µs+9µs) by Function::Parameters::BEGIN@3.2 at line 3 of Function/Parameters.pm # once (26µs+7µs) by Sorthash::BEGIN@8.4 at line 8 of /homes/dcw/lib/perl5/DCW/Sorthash.pm # once (23µs+5µs) by NewBoard::BEGIN@17.3 at line 17 of NewBoard.pm # once (21µs+4µs) by main::BEGIN@13.6 at line 13 of NewIncNPlyPicker.pm # once (18µs+4µs) by main::BEGIN@5.8 at line 5 of NewSolveGame.pm sub import {
35	181	263µs			my $class = shift;
36					if (@_ == 0) {
37					croak("No features specified");
38					}
39					while (@_) {
40					my $name = shift(@_);
41					if (substr($name, 0, 1) eq ":") {
42					my $v = substr($name, 1);
43					if (!exists $feature_bundle{$v}) {
44			18	43µs	$v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; # spent 32µs making 6 calls to feature::CORE:subst, avg 5µs/call # spent 12µs making 12 calls to feature::CORE:substcont, avg 983ns/call
45					if (!exists $feature_bundle{$v}) {
46					unknown_feature_bundle(substr($name, 1));
47					}
48					}
49					unshift @_, @{$feature_bundle{$v}};
50					next;
51					}
52					if (!exists $feature{$name}) {
53					unknown_feature($name);
54					}
55					$^H{$feature{$name}} = 1;
56					$^H \|= $hint_uni8bit if $name eq 'unicode_strings';
57					}
58					}
59
60					sub unimport {
61					my $class = shift;
62
63					# A bare C<no feature> should disable all features
64					if (!@_) {
65					delete @^H{ values(%feature) };
66					$^H &= ~ $hint_uni8bit;
67					return;
68					}
69
70					while (@_) {
71					my $name = shift;
72					if (substr($name, 0, 1) eq ":") {
73					my $v = substr($name, 1);
74					if (!exists $feature_bundle{$v}) {
75					$v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
76					if (!exists $feature_bundle{$v}) {
77					unknown_feature_bundle(substr($name, 1));
78					}
79					}
80					unshift @_, @{$feature_bundle{$v}};
81					next;
82					}
83					if (!exists($feature{$name})) {
84					unknown_feature($name);
85					}
86					else {
87					delete $^H{$feature{$name}};
88					$^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
89					}
90					}
91					}
92
93					sub unknown_feature {
94					my $feature = shift;
95					croak(sprintf('Feature "%s" is not supported by Perl %vd',
96					$feature, $^V));
97					}
98
99					sub unknown_feature_bundle {
100					my $feature = shift;
101					croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
102					$feature, $^V));
103					}
104
105					sub croak {
106					require Carp;
107					Carp::croak(@_);
108					}
109
110	1	13µs			1;

					# spent 32µs within feature::CORE:subst which was called 6 times, avg 5µs/call: # 6 times (32µs+0s) by feature::import at line 44, avg 5µs/call sub feature::CORE:subst; # opcode
					# spent 12µs within feature::CORE:substcont which was called 12 times, avg 983ns/call: # 12 times (12µs+0s) by feature::import at line 44, avg 983ns/call sub feature::CORE:substcont; # opcode