In perl.git, the branch nicholas/feature-code-shrink has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c82d70d7106ab5f3f9edac8b96ab40ddbc6a082f?hp=ae0ed4a664771994ed0657565e4930543f524469>
- Log ----------------------------------------------------------------- commit c82d70d7106ab5f3f9edac8b96ab40ddbc6a082f Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 23:54:10 2012 +0100 In feature.pm, inline current_bundle() into __common(), its only caller. current_bundle() was added after 5.14.0 was released, so has never been in a stable release. Hence it's totally safe to kill it. M lib/feature.pm M regen/feature.pl commit 9a66f664966e1fe68fa8334413ccaf4858344c1b Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 18:33:08 2012 +0100 In feature.pm, inline normalise_hints() into __common(), its only caller. normalise_hints() was added after 5.14.0 was released, so has never been in a stable release. Hence it's totally safe to kill it. M lib/feature.pm M regen/feature.pl commit 273e5ccdce4db672d98443476a8eadaf8b6f940a Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 18:24:57 2012 +0100 Merge the code common to feature::import and feature::unimport. M lib/feature.pm M regen/feature.pl commit 94155e176e37e1ed981d4afa2e52fdafd3308a49 Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 17:57:54 2012 +0100 In feature.pm, use a consistent code style in import() and unimport(). There were a couple of inconsistencies (shift with/without an explicit @_, exists with/without(), !@_ vs @_ == 0) which turn out to date back to before 5.10.0 Also fix an inadvertent use of a single element array slice with a simple array lookup in current_bundle(). M lib/feature.pm M regen/feature.pl ----------------------------------------------------------------------- Summary of changes: lib/feature.pm | 71 +++++++++++++++++++---------------------------------- regen/feature.pl | 71 +++++++++++++++++++---------------------------------- 2 files changed, 52 insertions(+), 90 deletions(-) diff --git a/lib/feature.pm b/lib/feature.pm index 58380e9..87b42aa 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -299,50 +299,14 @@ bundle is automatically loaded instead. =cut -sub current_bundle { - my $bundle_number = $^H & $hint_mask; - return if $bundle_number == $hint_mask; - return $feature_bundle{@hint_bundles[$bundle_number >> $hint_shift]}; -} - -sub normalise_hints { - # Delete any keys that may be left over from last time. - delete @^H{ values(%feature) }; - $^H |= $hint_mask; - for (@{+shift}) { - $^H{$feature{$_}} = 1; - $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; - } -} - sub import { my $class = shift; - if (@_ == 0) { + + if (!@_) { croak("No features specified"); } - if (my $features = current_bundle) { - # Features are enabled implicitly via bundle hints. - normalise_hints $features; - } - while (@_) { - my $name = shift(@_); - if (substr($name, 0, 1) eq ":") { - my $v = substr($name, 1); - if (!exists $feature_bundle{$v}) { - $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; - if (!exists $feature_bundle{$v}) { - unknown_feature_bundle(substr($name, 1)); - } - } - unshift @_, @{$feature_bundle{$v}}; - next; - } - if (!exists $feature{$name}) { - unknown_feature($name); - } - $^H{$feature{$name}} = 1; - $^H |= $hint_uni8bit if $name eq 'unicode_strings'; - } + + __common(1, @_); } sub unimport { @@ -354,11 +318,25 @@ sub unimport { return; } - if (my $features = current_bundle) { + __common(0, @_); +} + + +sub __common { + my $import = shift; + my $bundle_number = $^H & $hint_mask; + my $features = $bundle_number != $hint_mask + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + if ($features) { # Features are enabled implicitly via bundle hints. - normalise_hints $features; + # Delete any keys that may be left over from last time. + delete @^H{ values(%feature) }; + $^H |= $hint_mask; + for (@$features) { + $^H{$feature{$_}} = 1; + $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; + } } - while (@_) { my $name = shift; if (substr($name, 0, 1) eq ":") { @@ -372,10 +350,13 @@ sub unimport { unshift @_, @{$feature_bundle{$v}}; next; } - if (!exists($feature{$name})) { + if (!exists $feature{$name}) { unknown_feature($name); } - else { + if ($import) { + $^H{$feature{$name}} = 1; + $^H |= $hint_uni8bit if $name eq 'unicode_strings'; + } else { delete $^H{$feature{$name}}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } diff --git a/regen/feature.pl b/regen/feature.pl index aaac912..2a8d369 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -583,50 +583,14 @@ bundle is automatically loaded instead. =cut -sub current_bundle { - my $bundle_number = $^H & $hint_mask; - return if $bundle_number == $hint_mask; - return $feature_bundle{@hint_bundles[$bundle_number >> $hint_shift]}; -} - -sub normalise_hints { - # Delete any keys that may be left over from last time. - delete @^H{ values(%feature) }; - $^H |= $hint_mask; - for (@{+shift}) { - $^H{$feature{$_}} = 1; - $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; - } -} - sub import { my $class = shift; - if (@_ == 0) { + + if (!@_) { croak("No features specified"); } - if (my $features = current_bundle) { - # Features are enabled implicitly via bundle hints. - normalise_hints $features; - } - while (@_) { - my $name = shift(@_); - if (substr($name, 0, 1) eq ":") { - my $v = substr($name, 1); - if (!exists $feature_bundle{$v}) { - $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; - if (!exists $feature_bundle{$v}) { - unknown_feature_bundle(substr($name, 1)); - } - } - unshift @_, @{$feature_bundle{$v}}; - next; - } - if (!exists $feature{$name}) { - unknown_feature($name); - } - $^H{$feature{$name}} = 1; - $^H |= $hint_uni8bit if $name eq 'unicode_strings'; - } + + __common(1, @_); } sub unimport { @@ -638,11 +602,25 @@ sub unimport { return; } - if (my $features = current_bundle) { + __common(0, @_); +} + + +sub __common { + my $import = shift; + my $bundle_number = $^H & $hint_mask; + my $features = $bundle_number != $hint_mask + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + if ($features) { # Features are enabled implicitly via bundle hints. - normalise_hints $features; + # Delete any keys that may be left over from last time. + delete @^H{ values(%feature) }; + $^H |= $hint_mask; + for (@$features) { + $^H{$feature{$_}} = 1; + $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; + } } - while (@_) { my $name = shift; if (substr($name, 0, 1) eq ":") { @@ -656,10 +634,13 @@ sub unimport { unshift @_, @{$feature_bundle{$v}}; next; } - if (!exists($feature{$name})) { + if (!exists $feature{$name}) { unknown_feature($name); } - else { + if ($import) { + $^H{$feature{$name}} = 1; + $^H |= $hint_uni8bit if $name eq 'unicode_strings'; + } else { delete $^H{$feature{$name}}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } -- Perl5 Master Repository
