Filename | /usr/share/perl/5.28/feature.pm |
Statements | Executed 43 statements in 78µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 28µs | 28µs | __common | feature::
1 | 1 | 1 | 7µs | 35µs | import | feature::
0 | 0 | 0 | 0s | 0s | croak | feature::
0 | 0 | 0 | 0s | 0s | unimport | feature::
0 | 0 | 0 | 0s | 0s | unknown_feature | feature::
0 | 0 | 0 | 0s | 0s | unknown_feature_bundle | feature::
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 | 400ns | our $VERSION = '1.52'; | ||
9 | |||||
10 | 1 | 9µs | our %feature = ( | ||
11 | fc => 'feature_fc', | ||||
12 | say => 'feature_say', | ||||
13 | state => 'feature_state', | ||||
14 | switch => 'feature_switch', | ||||
15 | bitwise => 'feature_bitwise', | ||||
16 | evalbytes => 'feature_evalbytes', | ||||
17 | array_base => 'feature_arybase', | ||||
18 | signatures => 'feature_signatures', | ||||
19 | current_sub => 'feature___SUB__', | ||||
20 | refaliasing => 'feature_refaliasing', | ||||
21 | postderef_qq => 'feature_postderef_qq', | ||||
22 | unicode_eval => 'feature_unieval', | ||||
23 | declared_refs => 'feature_myref', | ||||
24 | unicode_strings => 'feature_unicode', | ||||
25 | ); | ||||
26 | |||||
27 | 1 | 6µs | our %feature_bundle = ( | ||
28 | "5.10" => [qw(array_base say state switch)], | ||||
29 | "5.11" => [qw(array_base say state switch unicode_strings)], | ||||
30 | "5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)], | ||||
31 | "5.23" => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)], | ||||
32 | "5.27" => [qw(bitwise current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)], | ||||
33 | "all" => [qw(array_base bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], | ||||
34 | "default" => [qw(array_base)], | ||||
35 | ); | ||||
36 | |||||
37 | 1 | 600ns | $feature_bundle{"5.12"} = $feature_bundle{"5.11"}; | ||
38 | 1 | 300ns | $feature_bundle{"5.13"} = $feature_bundle{"5.11"}; | ||
39 | 1 | 300ns | $feature_bundle{"5.14"} = $feature_bundle{"5.11"}; | ||
40 | 1 | 700ns | $feature_bundle{"5.16"} = $feature_bundle{"5.15"}; | ||
41 | 1 | 300ns | $feature_bundle{"5.17"} = $feature_bundle{"5.15"}; | ||
42 | 1 | 300ns | $feature_bundle{"5.18"} = $feature_bundle{"5.15"}; | ||
43 | 1 | 200ns | $feature_bundle{"5.19"} = $feature_bundle{"5.15"}; | ||
44 | 1 | 200ns | $feature_bundle{"5.20"} = $feature_bundle{"5.15"}; | ||
45 | 1 | 200ns | $feature_bundle{"5.21"} = $feature_bundle{"5.15"}; | ||
46 | 1 | 200ns | $feature_bundle{"5.22"} = $feature_bundle{"5.15"}; | ||
47 | 1 | 200ns | $feature_bundle{"5.24"} = $feature_bundle{"5.23"}; | ||
48 | 1 | 200ns | $feature_bundle{"5.25"} = $feature_bundle{"5.23"}; | ||
49 | 1 | 200ns | $feature_bundle{"5.26"} = $feature_bundle{"5.23"}; | ||
50 | 1 | 200ns | $feature_bundle{"5.28"} = $feature_bundle{"5.27"}; | ||
51 | 1 | 800ns | $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"}; | ||
52 | 1 | 1µs | my %noops = ( | ||
53 | postderef => 1, | ||||
54 | lexical_subs => 1, | ||||
55 | ); | ||||
56 | |||||
57 | 1 | 200ns | our $hint_shift = 26; | ||
58 | 1 | 100ns | our $hint_mask = 0x1c000000; | ||
59 | 1 | 900ns | our @hint_bundles = qw( default 5.10 5.11 5.15 5.23 5.27 ); | ||
60 | |||||
61 | # This gets set (for now) in $^H as well as in %^H, | ||||
62 | # for runtime speed of the uc/lc/ucfirst/lcfirst functions. | ||||
63 | # See HINT_UNI_8_BIT in perl.h. | ||||
64 | 1 | 200ns | our $hint_uni8bit = 0x00000800; | ||
65 | |||||
66 | # TODO: | ||||
67 | # - think about versioned features (use feature switch => 2) | ||||
68 | |||||
69 | # spent 35µs (7+28) within feature::import which was called:
# once (7µs+28µs) by RBM::BEGIN@24 at line 24 of /root/tor-browser-build/rbm/lib/RBM.pm | ||||
70 | 1 | 400ns | shift; | ||
71 | |||||
72 | 1 | 200ns | if (!@_) { | ||
73 | croak("No features specified"); | ||||
74 | } | ||||
75 | |||||
76 | 1 | 4µs | 1 | 28µs | __common(1, @_); # spent 28µs making 1 call to feature::__common |
77 | } | ||||
78 | |||||
79 | sub unimport { | ||||
80 | shift; | ||||
81 | |||||
82 | # A bare C<no feature> should reset to the default bundle | ||||
83 | if (!@_) { | ||||
84 | $^H &= ~($hint_uni8bit|$hint_mask); | ||||
85 | return; | ||||
86 | } | ||||
87 | |||||
88 | __common(0, @_); | ||||
89 | } | ||||
90 | |||||
91 | # spent 28µs within feature::__common which was called:
# once (28µs+0s) by feature::import at line 76 | ||||
92 | 1 | 300ns | my $import = shift; | ||
93 | 1 | 1µs | my $bundle_number = $^H & $hint_mask; | ||
94 | my $features = $bundle_number != $hint_mask | ||||
95 | 1 | 800ns | && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; | ||
96 | 1 | 200ns | if ($features) { | ||
97 | # Features are enabled implicitly via bundle hints. | ||||
98 | # Delete any keys that may be left over from last time. | ||||
99 | 1 | 17µs | delete @^H{ values(%feature) }; | ||
100 | 1 | 1µs | $^H |= $hint_mask; | ||
101 | 1 | 600ns | for (@$features) { | ||
102 | 1 | 2µs | $^H{$feature{$_}} = 1; | ||
103 | 1 | 500ns | $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; | ||
104 | } | ||||
105 | } | ||||
106 | 1 | 5µs | while (@_) { | ||
107 | 1 | 300ns | my $name = shift; | ||
108 | 1 | 900ns | if (substr($name, 0, 1) eq ":") { | ||
109 | my $v = substr($name, 1); | ||||
110 | if (!exists $feature_bundle{$v}) { | ||||
111 | $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; | ||||
112 | if (!exists $feature_bundle{$v}) { | ||||
113 | unknown_feature_bundle(substr($name, 1)); | ||||
114 | } | ||||
115 | } | ||||
116 | unshift @_, @{$feature_bundle{$v}}; | ||||
117 | next; | ||||
118 | } | ||||
119 | 1 | 400ns | if (!exists $feature{$name}) { | ||
120 | if (exists $noops{$name}) { | ||||
121 | next; | ||||
122 | } | ||||
123 | unknown_feature($name); | ||||
124 | } | ||||
125 | 1 | 800ns | if ($import) { | ||
126 | 1 | 1µs | $^H{$feature{$name}} = 1; | ||
127 | 1 | 200ns | $^H |= $hint_uni8bit if $name eq 'unicode_strings'; | ||
128 | } else { | ||||
129 | delete $^H{$feature{$name}}; | ||||
130 | $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; | ||||
131 | } | ||||
132 | } | ||||
133 | } | ||||
134 | |||||
135 | sub unknown_feature { | ||||
136 | my $feature = shift; | ||||
137 | croak(sprintf('Feature "%s" is not supported by Perl %vd', | ||||
138 | $feature, $^V)); | ||||
139 | } | ||||
140 | |||||
141 | sub unknown_feature_bundle { | ||||
142 | my $feature = shift; | ||||
143 | croak(sprintf('Feature bundle "%s" is not supported by Perl %vd', | ||||
144 | $feature, $^V)); | ||||
145 | } | ||||
146 | |||||
147 | sub croak { | ||||
148 | require Carp; | ||||
149 | Carp::croak(@_); | ||||
150 | } | ||||
151 | |||||
152 | 1 | 18µs | 1; | ||
153 | |||||
154 | # ex: set ro: |