Close the filehandle actually being tested in uni/readline.t

[perl5.git] / lib / feature.pm

diff --git a/lib/feature.pm b/lib/feature.pm
index 8dfb7aa..37e571f 100644 (file)
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -5,9 +5,10 @@
 
 package feature;
 
-our $VERSION = '1.25';
+our $VERSION = '1.28';
 
 our %feature = (
+    fc              => 'feature_fc',
     say             => 'feature_say',
     state           => 'feature_state',
     switch          => 'feature_switch',
@@ -21,7 +22,8 @@ our %feature = (
 our %feature_bundle = (
     "5.10"    => [qw(array_base say state switch)],
     "5.11"    => [qw(array_base say state switch unicode_strings)],
-    "5.15"    => [qw(current_sub evalbytes say state switch unicode_eval unicode_strings)],
+    "5.15"    => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
+    "all"     => [qw(array_base current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
     "default" => [qw(array_base)],
 );
 
@@ -29,6 +31,8 @@ $feature_bundle{"5.12"} = $feature_bundle{"5.11"};
 $feature_bundle{"5.13"} = $feature_bundle{"5.11"};
 $feature_bundle{"5.14"} = $feature_bundle{"5.11"};
 $feature_bundle{"5.16"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.17"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.18"} = $feature_bundle{"5.15"};
 $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
 
 our $hint_shift   = 26;
@@ -97,7 +101,8 @@ has lexical effect.
     }
     say "Yet it is here.";
 
-C<no feature> with no features specified will turn off all features.
+C<no feature> with no features specified will reset to the default group.  To
+disable I<all> features (an unusual request!) use C<no feature ':all'>.
 
 =head1 AVAILABLE FEATURES
 
@@ -124,7 +129,7 @@ This feature is available starting with Perl 5.10.
 C<use feature 'switch'> tells the compiler to enable the Perl 6
 given/when construct.
 
-See L<perlsyn/"Switch statements"> for details.
+See L<perlsyn/"Switch Statements"> for details.
 
 This feature is available starting with Perl 5.10.
 
@@ -144,8 +149,8 @@ L<perlunicode/The "Unicode Bug"> for details.)  For this reason, if you are
 potentially using Unicode in your program, the
 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
 
-This feature is available starting with Perl 5.12, but was not fully
-implemented until Perl 5.14.
+This feature is available starting with Perl 5.12; was almost fully
+implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
 
 =head2 The 'unicode_eval' and 'evalbytes' features
 
@@ -211,6 +216,15 @@ This feature is available under this name starting with Perl 5.16.  In
 previous versions, it was simply on all the time, and this pragma knew
 nothing about it.
 
+=head2 The 'fc' feature
+
+C<use feature 'fc'> tells the compiler to enable the C<fc> function,
+which implements Unicode casefolding.
+
+See L<perlfunc/fc> for details.
+
+This feature is available from Perl 5.16 onwards.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
@@ -232,7 +246,10 @@ The following feature bundles are available:
   :5.14     say state switch unicode_strings array_base
 
   :5.16     say state switch unicode_strings
-            unicode_eval evalbytes current_sub
+            unicode_eval evalbytes current_sub fc
+
+  :5.18     say state switch unicode_strings
+            unicode_eval evalbytes current_sub fc
 
 The C<:default> bundle represents the feature set that is enabled before
 any C<use feature> or C<no feature> declaration.
@@ -267,7 +284,7 @@ the C<use VERSION> construct.  That is,
 
 will do an implicit
 
-    no feature;
+    no feature ':all';
     use feature ':5.10';
 
 and so on.  Note how the trailing sub-version
@@ -287,67 +304,44 @@ 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 {
     my $class = shift;
 
-    if (my $features = current_bundle) {
-       # Features are enabled implicitly via bundle hints.
-       normalise_hints $features;
-    }
-
-    # A bare C<no feature> should disable *all* features
+    # A bare C<no feature> should reset to the default bundle
     if (!@_) {
-        delete @^H{ values(%feature) };
-        $^H &= ~ $hint_uni8bit;
-        return;
+       $^H &= ~($hint_uni8bit|$hint_mask);
+       return;
     }
 
+    __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.
+       # 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 ":") {
@@ -361,10 +355,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';
         }