This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
feature.pm: Move hint normalisation to separate function
authorFather Chrysostomos <sprout@cpan.org>
Fri, 23 Dec 2011 06:31:59 +0000 (22:31 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 24 Dec 2011 17:25:19 +0000 (09:25 -0800)
PL_hints/$^H can hold feature bundle hints that cause %^H to be
ignored when features are looked up.

When feature->import and ->unimport are invoked, they set bits in $^H
such that %^H is used once more.  But they have to modify %^H to con-
tain what the bits in $^H imply.

Up till now, unimport was delegating to import, which meant that more
work was being done than necessary, because import would then detect
the special condition of $^H and repeat (some of) that work.

lib/feature.pm
regen/feature.pl

index 75c6666..ff1dd6d 100644 (file)
@@ -293,6 +293,16 @@ sub current_bundle {
     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) {
@@ -300,12 +310,7 @@ sub import {
     }
     if (my $features = current_bundle) {
        # Features are enabled implicitly via bundle hints.
-
-       # Delete any keys that may be left over from last time.
-       delete @^H{ values(%feature) };
-
-       unshift @_, @$features;
-       $^H |= $hint_mask;
+       normalise_hints $features;
     }
     while (@_) {
         my $name = shift(@_);
@@ -332,10 +337,8 @@ sub unimport {
     my $class = shift;
 
     if (my $features = current_bundle) {
-       # Features are enabled implicitly via bundle hints
-       # Pass them to import() to put them in a form we can handle.
-       import(undef, @$features);
-       $^H |= $hint_mask;
+       # Features are enabled implicitly via bundle hints.
+       normalise_hints $features;
     }
 
     # A bare C<no feature> should disable *all* features
index cbf4db8..bbaf157 100755 (executable)
@@ -561,6 +561,16 @@ sub current_bundle {
     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) {
@@ -568,12 +578,7 @@ sub import {
     }
     if (my $features = current_bundle) {
        # Features are enabled implicitly via bundle hints.
-
-       # Delete any keys that may be left over from last time.
-       delete @^H{ values(%feature) };
-
-       unshift @_, @$features;
-       $^H |= $hint_mask;
+       normalise_hints $features;
     }
     while (@_) {
         my $name = shift(@_);
@@ -600,10 +605,8 @@ sub unimport {
     my $class = shift;
 
     if (my $features = current_bundle) {
-       # Features are enabled implicitly via bundle hints
-       # Pass them to import() to put them in a form we can handle.
-       import(undef, @$features);
-       $^H |= $hint_mask;
+       # Features are enabled implicitly via bundle hints.
+       normalise_hints $features;
     }
 
     # A bare C<no feature> should disable *all* features