[perl #113718] Add inline.h

[perl5.git] / regen / feature.pl

diff --git a/regen/feature.pl b/regen/feature.pl
index aaac912..1a85d0a 100755 (executable)
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -37,18 +37,17 @@ my %feature = (
 #       versions, any code below that uses %BundleRanges will have to
 #       be changed to account.
 
+# 5.odd implies the next 5.even, but an explicit 5.even can override it.
 my %feature_bundle = (
      all     => [ keys %feature ],
      default =>        [qw(array_base)],
     "5.9.5"  =>        [qw(say state switch array_base)],
     "5.10"   =>        [qw(say state switch array_base)],
     "5.11"   =>        [qw(say state switch unicode_strings array_base)],
-    "5.12"   =>        [qw(say state switch unicode_strings array_base)],
     "5.13"   =>        [qw(say state switch unicode_strings array_base)],
-    "5.14"   =>        [qw(say state switch unicode_strings array_base)],
     "5.15"   =>        [qw(say state switch unicode_strings unicode_eval
                    evalbytes current_sub fc)],
-    "5.16"   =>        [qw(say state switch unicode_strings unicode_eval
+    "5.17"   =>        [qw(say state switch unicode_strings unicode_eval
                    evalbytes current_sub fc)],
 );
 
@@ -56,6 +55,11 @@ my %feature_bundle = (
 ###########################################################################
 # More data generated from the above
 
+for (keys %feature_bundle) {
+    next unless /^5\.(\d*[13579])\z/;
+    $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
+}
+
 my %UniqueBundles; # "say state switch" => 5.10
 my %Aliases;       #  5.12 => 5.11
 for( sort keys %feature_bundle ) {
@@ -231,10 +235,12 @@ print $h <<'EOH';
 #define CURRENT_FEATURE_BUNDLE \
     ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
 
+/* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
+   the HP-UX cc on PA-RISC */
 #define FEATURE_IS_ENABLED(name)                                       \
        ((CURRENT_HINTS                                                  \
           & HINT_LOCALIZE_HH)                                            \
-           && Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
+           ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
 /* The longest string we pass in.  */
 EOH
 
@@ -332,7 +338,7 @@ read_only_bottom_close_and_rename($h);
 __END__
 package feature;
 
-our $VERSION = '1.27';
+our $VERSION = '1.29';
 
 FEATURES
 
@@ -431,7 +437,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
@@ -583,50 +590,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 +609,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 +641,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';
         }