| Filename | /usr/share/perl/5.28/feature.pm |
| Statements | Executed 43 statements in 77µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 25µs | 25µs | feature::__common |
| 1 | 1 | 1 | 7µs | 32µs | feature::import |
| 0 | 0 | 0 | 0s | 0s | feature::croak |
| 0 | 0 | 0 | 0s | 0s | feature::unimport |
| 0 | 0 | 0 | 0s | 0s | feature::unknown_feature |
| 0 | 0 | 0 | 0s | 0s | feature::unknown_feature_bundle |
| 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 | 12µ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 | 600ns | $feature_bundle{"5.16"} = $feature_bundle{"5.15"}; | ||
| 41 | 1 | 200ns | $feature_bundle{"5.17"} = $feature_bundle{"5.15"}; | ||
| 42 | 1 | 200ns | $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 | 100ns | $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 | 200ns | $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"}; | ||
| 52 | 1 | 2µs | my %noops = ( | ||
| 53 | postderef => 1, | ||||
| 54 | lexical_subs => 1, | ||||
| 55 | ); | ||||
| 56 | |||||
| 57 | 1 | 100ns | 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 | 100ns | our $hint_uni8bit = 0x00000800; | ||
| 65 | |||||
| 66 | # TODO: | ||||
| 67 | # - think about versioned features (use feature switch => 2) | ||||
| 68 | |||||
| 69 | # spent 32µs (7+25) within feature::import which was called:
# once (7µs+25µs) by RBM::BEGIN@24 at line 24 of /root/tor-browser-build/rbm/lib/RBM.pm | ||||
| 70 | 1 | 200ns | shift; | ||
| 71 | |||||
| 72 | 1 | 200ns | if (!@_) { | ||
| 73 | croak("No features specified"); | ||||
| 74 | } | ||||
| 75 | |||||
| 76 | 1 | 3µs | 1 | 25µs | __common(1, @_); # spent 25µ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 25µs within feature::__common which was called:
# once (25µs+0s) by feature::import at line 76 | ||||
| 92 | 1 | 200ns | my $import = shift; | ||
| 93 | 1 | 1µs | my $bundle_number = $^H & $hint_mask; | ||
| 94 | my $features = $bundle_number != $hint_mask | ||||
| 95 | 1 | 900ns | && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; | ||
| 96 | 1 | 300ns | if ($features) { | ||
| 97 | # Features are enabled implicitly via bundle hints. | ||||
| 98 | # Delete any keys that may be left over from last time. | ||||
| 99 | 1 | 15µs | delete @^H{ values(%feature) }; | ||
| 100 | 1 | 700ns | $^H |= $hint_mask; | ||
| 101 | 1 | 500ns | for (@$features) { | ||
| 102 | 1 | 1µs | $^H{$feature{$_}} = 1; | ||
| 103 | 1 | 500ns | $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; | ||
| 104 | } | ||||
| 105 | } | ||||
| 106 | 1 | 6µs | while (@_) { | ||
| 107 | 1 | 200ns | 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 | 300ns | if (!exists $feature{$name}) { | ||
| 120 | if (exists $noops{$name}) { | ||||
| 121 | next; | ||||
| 122 | } | ||||
| 123 | unknown_feature($name); | ||||
| 124 | } | ||||
| 125 | 1 | 700ns | if ($import) { | ||
| 126 | 1 | 1µs | $^H{$feature{$name}} = 1; | ||
| 127 | 1 | 100ns | $^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: |