Make printf, sprintf respect 'use locale' for radix

[perl5.git] / lib / feature.pm

diff --git a/lib/feature.pm b/lib/feature.pm
index 58380e9..78fae2e 100644 (file)
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -5,7 +5,7 @@
 
 package feature;
 
-our $VERSION = '1.27';
+our $VERSION = '1.33';
 
 our %feature = (
     fc              => 'feature_fc',
@@ -15,6 +15,7 @@ our %feature = (
     evalbytes       => 'feature_evalbytes',
     array_base      => 'feature_arybase',
     current_sub     => 'feature___SUB__',
+    lexical_subs    => 'feature_lexsubs',
     unicode_eval    => 'feature_unieval',
     unicode_strings => 'feature_unicode',
 );
@@ -23,7 +24,7 @@ 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 fc say state switch unicode_eval unicode_strings)],
-    "all"     => [qw(array_base current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
+    "all"     => [qw(array_base current_sub evalbytes fc lexical_subs say state switch unicode_eval unicode_strings)],
     "default" => [qw(array_base)],
 );
 
@@ -31,6 +32,10 @@ $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.19"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.20"} = $feature_bundle{"5.15"};
 $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
 
 our $hint_shift   = 26;
@@ -77,7 +82,7 @@ pragma.)
 =head2 Lexical effect
 
 Like other pragmas (C<use strict>, for example), features have a lexical
-effect. C<use feature qw(foo)> will only make the feature "foo" available
+effect.  C<use feature qw(foo)> will only make the feature "foo" available
 from that point to the end of the enclosing block.
 
     {
@@ -137,7 +142,8 @@ C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
 in all string operations executed within its scope (unless they are also
 within the scope of either C<use locale> or C<use bytes>).  The same applies
 to all regular expressions compiled within the scope, even if executed outside
-it.
+it.  It does not change the internal representation of strings, but only how
+they are interpreted.
 
 C<no feature 'unicode_strings'> tells the compiler to use the traditional
 Perl semantics wherein the native character set semantics is used unless it is
@@ -223,6 +229,20 @@ See L<perlfunc/fc> for details.
 
 This feature is available from Perl 5.16 onwards.
 
+=head2 The 'lexical_subs' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change in future versions of Perl.  For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the
+warning:
+
+    no warnings "experimental::lexical_subs";
+
+This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
+and C<our sub foo> syntax.  See L<perlsub/Lexical Subroutines> for details.
+
+This feature is available from Perl 5.18 onwards.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
@@ -246,6 +266,12 @@ The following feature bundles are available:
   :5.16     say state switch unicode_strings
             unicode_eval evalbytes current_sub fc
 
+  :5.18     say state switch unicode_strings
+            unicode_eval evalbytes current_sub fc
+
+  :5.20     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.
 
@@ -299,50 +325,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 +344,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 +376,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';
         }