← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:11 2016

Filename/usr/share/perl/5.18/feature.pm
StatementsExecuted 15 statements in 25µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sfeature::::__commonfeature::__common
0000s0sfeature::::croakfeature::croak
0000s0sfeature::::importfeature::import
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
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
6package feature;
7
81400nsour $VERSION = '1.32';
9
1016µsour %feature = (
11 fc => 'feature_fc',
12 say => 'feature_say',
13 state => 'feature_state',
14 switch => 'feature_switch',
15 evalbytes => 'feature_evalbytes',
16 array_base => 'feature_arybase',
17 current_sub => 'feature___SUB__',
18 lexical_subs => 'feature_lexsubs',
19 unicode_eval => 'feature_unieval',
20 unicode_strings => 'feature_unicode',
21);
22
2316µsour %feature_bundle = (
24 "5.10" => [qw(array_base say state switch)],
25 "5.11" => [qw(array_base say state switch unicode_strings)],
26 "5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
27 "all" => [qw(array_base current_sub evalbytes fc lexical_subs say state switch unicode_eval unicode_strings)],
28 "default" => [qw(array_base)],
29);
30
3111µs$feature_bundle{"5.12"} = $feature_bundle{"5.11"};
321300ns$feature_bundle{"5.13"} = $feature_bundle{"5.11"};
331400ns$feature_bundle{"5.14"} = $feature_bundle{"5.11"};
341300ns$feature_bundle{"5.16"} = $feature_bundle{"5.15"};
351200ns$feature_bundle{"5.17"} = $feature_bundle{"5.15"};
361100ns$feature_bundle{"5.18"} = $feature_bundle{"5.15"};
371200ns$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
38
391100nsour $hint_shift = 26;
4010sour $hint_mask = 0x1c000000;
411900nsour @hint_bundles = qw( default 5.10 5.11 5.15 );
42
43# This gets set (for now) in $^H as well as in %^H,
44# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
45# See HINT_UNI_8_BIT in perl.h.
461100nsour $hint_uni8bit = 0x00000800;
47
48# TODO:
49# - think about versioned features (use feature switch => 2)
50
51sub import {
52 my $class = shift;
53
54 if (!@_) {
55 croak("No features specified");
56 }
57
58 __common(1, @_);
59}
60
61sub unimport {
62 my $class = shift;
63
64 # A bare C<no feature> should reset to the default bundle
65 if (!@_) {
66 $^H &= ~($hint_uni8bit|$hint_mask);
67 return;
68 }
69
70 __common(0, @_);
71}
72
73sub __common {
74 my $import = shift;
75 my $bundle_number = $^H & $hint_mask;
76 my $features = $bundle_number != $hint_mask
77 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
78 if ($features) {
79 # Features are enabled implicitly via bundle hints.
80 # Delete any keys that may be left over from last time.
81 delete @^H{ values(%feature) };
82 $^H |= $hint_mask;
83 for (@$features) {
84 $^H{$feature{$_}} = 1;
85 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
86 }
87 }
88 while (@_) {
89 my $name = shift;
90 if (substr($name, 0, 1) eq ":") {
91 my $v = substr($name, 1);
92 if (!exists $feature_bundle{$v}) {
93 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
94 if (!exists $feature_bundle{$v}) {
95 unknown_feature_bundle(substr($name, 1));
96 }
97 }
98 unshift @_, @{$feature_bundle{$v}};
99 next;
100 }
101 if (!exists $feature{$name}) {
102 unknown_feature($name);
103 }
104 if ($import) {
105 $^H{$feature{$name}} = 1;
106 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
107 } else {
108 delete $^H{$feature{$name}};
109 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
110 }
111 }
112}
113
114sub unknown_feature {
115 my $feature = shift;
116 croak(sprintf('Feature "%s" is not supported by Perl %vd',
117 $feature, $^V));
118}
119
120sub unknown_feature_bundle {
121 my $feature = shift;
122 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
123 $feature, $^V));
124}
125
126sub croak {
127 require Carp;
128 Carp::croak(@_);
129}
130
13118µs1;
132
133# ex: set ro: