Profile of feature.pm

Filename	/usr/share/perl/5.20/feature.pm
Statements	Executed 213 statements in 250µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
4	1	1	188µs	188µs	feature::::__commonfeature::__common
4	1	1	23µs	211µs	feature::::importfeature::import
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					# -- buffer-read-only: t --
2					# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
3					# This file is built by regen/feature.pl.
4					# Any changes made here will be lost!
5
6					package feature;
7
8	1	700ns			our $VERSION = '1.36';
9
10	1	7µs			our %feature = (
11					fc => 'feature_fc',
12					say => 'feature_say',
13					state => 'feature_state',
14					switch => 'feature_switch',
15					evalbytes => 'feature_evalbytes',
16					postderef => 'feature_postderef',
17					array_base => 'feature_arybase',
18					signatures => 'feature_signatures',
19					current_sub => 'feature___SUB__',
20					lexical_subs => 'feature_lexsubs',
21					postderef_qq => 'feature_postderef_qq',
22					unicode_eval => 'feature_unieval',
23					unicode_strings => 'feature_unicode',
24					);
25
26	1	8µs			our %feature_bundle = (
27					"5.10" => [qw(array_base say state switch)],
28					"5.11" => [qw(array_base say state switch unicode_strings)],
29					"5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
30					"all" => [qw(array_base current_sub evalbytes fc lexical_subs postderef postderef_qq say signatures state switch unicode_eval unicode_strings)],
31					"default" => [qw(array_base)],
32					);
33
34	1	1µs			$feature_bundle{"5.12"} = $feature_bundle{"5.11"};
35	1	400ns			$feature_bundle{"5.13"} = $feature_bundle{"5.11"};
36	1	800ns			$feature_bundle{"5.14"} = $feature_bundle{"5.11"};
37	1	300ns			$feature_bundle{"5.16"} = $feature_bundle{"5.15"};
38	1	300ns			$feature_bundle{"5.17"} = $feature_bundle{"5.15"};
39	1	300ns			$feature_bundle{"5.18"} = $feature_bundle{"5.15"};
40	1	300ns			$feature_bundle{"5.19"} = $feature_bundle{"5.15"};
41	1	300ns			$feature_bundle{"5.20"} = $feature_bundle{"5.15"};
42	1	400ns			$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
43
44	1	200ns			our $hint_shift = 26;
45	1	100ns			our $hint_mask = 0x1c000000;
46	1	1µs			our @hint_bundles = qw( default 5.10 5.11 5.15 );
47
48					# This gets set (for now) in $^H as well as in %^H,
49					# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
50					# See HINT_UNI_8_BIT in perl.h.
51	1	200ns			our $hint_uni8bit = 0x00000800;
52
53					# TODO:
54					# - think about versioned features (use feature switch => 2)
55
56					# spent 211µs (23+188) within feature::import which was called 4 times, avg 53µs/call: # 4 times (23µs+188µs) by Modern::Perl::import at line 43 of Modern/Perl.pm, avg 53µs/call sub import {
57	4	2µs			my $class = shift;
58
59	4	1µs			if (!@_) {
60					croak("No features specified");
61					}
62
63	4	16µs	4	188µs	__common(1, @_); # spent 188µs making 4 calls to feature::__common, avg 47µs/call
64					}
65
66					sub unimport {
67					my $class = shift;
68
69					# A bare C<no feature> should reset to the default bundle
70					if (!@_) {
71					$^H &= ~($hint_uni8bit\|$hint_mask);
72					return;
73					}
74
75					__common(0, @_);
76					}
77
78					# spent 188µs within feature::__common which was called 4 times, avg 47µs/call: # 4 times (188µs+0s) by feature::import at line 63, avg 47µs/call sub __common {
79	4	1µs			my $import = shift;
80	4	4µs			my $bundle_number = $^H & $hint_mask;
81	4	9µs			my $features = $bundle_number != $hint_mask
82					&& $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
83	4	3µs			if ($features) {
84					# Features are enabled implicitly via bundle hints.
85					# Delete any keys that may be left over from last time.
86	4	71µs			delete @^H{ values(%feature) };
87	4	2µs			$^H \|= $hint_mask;
88	4	4µs			for (@$features) {
89	4	7µs			$^H{$feature{$_}} = 1;
90	4	4µs			$^H \|= $hint_uni8bit if $_ eq 'unicode_strings';
91					}
92					}
93	4	15µs			while (@_) {
94	24	6µs			my $name = shift;
95	24	13µs			if (substr($name, 0, 1) eq ":") {
96	4	2µs			my $v = substr($name, 1);
97	4	3µs			if (!exists $feature_bundle{$v}) {
98					$v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
99					if (!exists $feature_bundle{$v}) {
100					unknown_feature_bundle(substr($name, 1));
101					}
102					}
103	4	9µs			unshift @_, @{$feature_bundle{$v}};
104	4	2µs			next;
105					}
106	20	5µs			if (!exists $feature{$name}) {
107					unknown_feature($name);
108					}
109	20	6µs			if ($import) {
110	20	21µs			$^H{$feature{$name}} = 1;
111	20	6µs			$^H \|= $hint_uni8bit if $name eq 'unicode_strings';
112					} else {
113					delete $^H{$feature{$name}};
114					$^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
115					}
116					}
117					}
118
119					sub unknown_feature {
120					my $feature = shift;
121					croak(sprintf('Feature "%s" is not supported by Perl %vd',
122					$feature, $^V));
123					}
124
125					sub unknown_feature_bundle {
126					my $feature = shift;
127					croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
128					$feature, $^V));
129					}
130
131					sub croak {
132					require Carp;
133					Carp::croak(@_);
134					}
135
136	1	15µs			1;
137
138					# ex: set ro: