Eliminate ‘negative’ features

Now that we have hints in $^H to indicate the default feature bun-
dle, there is no need for entries in %^H that turn features off by
their presence.

diff --git a/embed.fnc b/embed.fnc
index 22886ed..27d63a9 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2574,6 +2574,6 @@ op        |void   |populate_isa   |NN const char *name|STRLEN len|...
 
 : Used in keywords.c and toke.c
 Xop    |bool   |feature_is_enabled|NN const char *const name \
-               |STRLEN namelen|bool negate
+               |STRLEN namelen
 
 : ex: set ts=8 sts=4 sw=4 noet:

diff --git a/feature.h b/feature.h
index 6c99c2a..31547fb 100644 (file)
--- a/feature.h
+++ b/feature.h
@@ -54,7 +54,7 @@
     ( \
        CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_511 \
      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
-        FEATURE_IS_ENABLED_d("arybase")) \
+        FEATURE_IS_ENABLED("arybase")) \
     )
 
 #define FEATURE___SUB___IS_ENABLED \

diff --git a/lib/feature.pm b/lib/feature.pm
index 6f7af31..c9e188b 100644 (file)
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -12,15 +12,12 @@ my %feature = (
     state           => 'feature_state',
     switch          => 'feature_switch',
     evalbytes       => 'feature_evalbytes',
+    array_base      => 'feature_arybase',
     current_sub     => 'feature___SUB__',
     unicode_eval    => 'feature_unieval',
     unicode_strings => 'feature_unicode',
 );
 
-my %default_feature = (
-    array_base => 'feature_noarybase',
-);
-
 our %feature_bundle = (
     "5.10"    => [qw(array_base say state switch)],
     "5.11"    => [qw(array_base say state switch unicode_strings)],
@@ -320,10 +317,7 @@ sub import {
             next;
         }
         if (!exists $feature{$name}) {
-         if (!exists $default_feature{$name}) {
             unknown_feature($name);
-         }
-         delete $^H{$default_feature{$name}}; next;
         }
         $^H{$feature{$name}} = 1;
         $^H |= $hint_uni8bit if $name eq 'unicode_strings';
@@ -344,7 +338,6 @@ sub unimport {
     if (!@_) {
         delete @^H{ values(%feature) };
         $^H &= ~ $hint_uni8bit;
-       @^H{ values(%default_feature) } = (1) x keys %default_feature;
         return;
     }
 
@@ -362,10 +355,7 @@ sub unimport {
             next;
         }
         if (!exists($feature{$name})) {
-         if (!exists $default_feature{$name}) {
             unknown_feature($name);
-         }
-         $^H{$default_feature{$name}} = 1; next;
         }
         else {
             delete $^H{$feature{$name}};

diff --git a/perl.h b/perl.h
index 1bf68be..4dcd259 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5751,11 +5751,7 @@ extern void moncontrol(int);
 #  define FEATURE_IS_ENABLED(name)                                     \
        (((PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints) \
           & HINT_LOCALIZE_HH)                                          \
-           && Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name), 0))
-#  define FEATURE_IS_ENABLED_d(name)                                   \
-       (!((PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints) \
-           & HINT_LOCALIZE_HH)                                         \
-           || Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name), 1))
+           && Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
 /* The longest string we pass in.  */
 #  define MAX_FEATURE_LEN (sizeof("unicode_strings")-1)
 #endif

diff --git a/proto.h b/proto.h
index 5184bff..6e180e3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -996,7 +996,7 @@ PERL_CALLCONV char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bige
 #define PERL_ARGS_ASSERT_FBM_INSTR     \
        assert(big); assert(bigend); assert(littlestr)
 
-PERL_CALLCONV bool     Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen, bool negate)
+PERL_CALLCONV bool     Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_FEATURE_IS_ENABLED    \
        assert(name)

diff --git a/regen/feature.pl b/regen/feature.pl
index f4e8d1e..ab60389 100755 (executable)
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -25,22 +25,18 @@ my %feature = (
     state           => 'state',
     switch          => 'switch',
     evalbytes       => 'evalbytes',
+    array_base      => 'arybase',
     current_sub     => '__SUB__',
     unicode_eval    => 'unieval',
     unicode_strings => 'unicode',
 );
 
-# These work backwards--the presence of the hint elem disables the feature:
-my %default_feature = (
-    array_base      => 'noarybase',
-);
-
 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
 #       versions, any code below that uses %BundleRanges will have to
 #       be changed to account.
 
 my %feature_bundle = (
-     default =>        [keys %default_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)],
@@ -147,14 +143,6 @@ for(sort { length $a <=> length $b } keys %feature) {
 }
 print $pm ");\n\n";
 
-print $pm "my %default_feature = (\n";
-$width = length longest keys %default_feature;
-for(sort { length $a <=> length $b } keys %default_feature) {
-    print $pm "    $_" . " "x($width-length)
-       . " => 'feature_$default_feature{$_}',\n";
-}
-print $pm ");\n\n";
-
 print $pm "our %feature_bundle = (\n";
 $width = length longest values %UniqueBundles;
 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
@@ -231,13 +219,11 @@ print $h <<EOH;
 EOH
 
 for (
-    sort { length $a <=> length $b } keys %feature, keys %default_feature
+    sort { length $a <=> length $b } keys %feature
 ) {
     my($first,$last) =
        map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
-    my $default = '';
-    my $name = $feature{$_}               # skip "no"
-           || ($default = '_d', substr $default_feature{$_}, 2);
+    my $name = $feature{$_};
     my $NAME = uc $name;
     if ($last && $first eq 'DEFAULT') { #  ‘>= DEFAULT’ warns
        print $h <<EOI;
@@ -245,7 +231,7 @@ for (
     ( \\
        CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
-        FEATURE_IS_ENABLED$default("$name")) \\
+        FEATURE_IS_ENABLED("$name")) \\
     )
 
 EOI
@@ -257,7 +243,7 @@ EOI
        (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
         CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
-        FEATURE_IS_ENABLED$default("$name")) \\
+        FEATURE_IS_ENABLED("$name")) \\
     )
 
 EOH3
@@ -268,7 +254,7 @@ EOH3
     ( \\
        CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
-        FEATURE_IS_ENABLED$default("$name")) \\
+        FEATURE_IS_ENABLED("$name")) \\
     )
 
 EOH4
@@ -565,10 +551,7 @@ sub import {
             next;
         }
         if (!exists $feature{$name}) {
-         if (!exists $default_feature{$name}) {
             unknown_feature($name);
-         }
-         delete $^H{$default_feature{$name}}; next;
         }
         $^H{$feature{$name}} = 1;
         $^H |= $hint_uni8bit if $name eq 'unicode_strings';
@@ -589,7 +572,6 @@ sub unimport {
     if (!@_) {
         delete @^H{ values(%feature) };
         $^H &= ~ $hint_uni8bit;
-       @^H{ values(%default_feature) } = (1) x keys %default_feature;
         return;
     }
 
@@ -607,10 +589,7 @@ sub unimport {
             next;
         }
         if (!exists($feature{$name})) {
-         if (!exists $default_feature{$name}) {
             unknown_feature($name);
-         }
-         $^H{$default_feature{$name}} = 1; next;
         }
         else {
             delete $^H{$feature{$name}};

diff --git a/toke.c b/toke.c
index 286eb96..8e4d9e5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -599,8 +599,7 @@ S_missingterm(pTHX_ char *s)
  * Check whether the named feature is enabled.
  */
 bool
-Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen,
-                             bool negate)
+Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
 {
     dVAR;
     char he_name[8 + MAX_FEATURE_LEN] = "feature_";
@@ -609,15 +608,13 @@ Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen,
 
     if (namelen > MAX_FEATURE_LEN)
        return FALSE;
-    if (negate) he_name[8] = 'n', he_name[9] = 'o';
-    memcpy(&he_name[8 + 2*negate], name, namelen);
+    memcpy(&he_name[8], name, namelen);
 
     return
-       !cop_hints_fetch_pvn(
-           PL_curcop, he_name, 8 + 2*negate + namelen, 0,
+       cop_hints_fetch_pvn(
+           PL_curcop, he_name, 8 + namelen, 0,
            REFCOUNTED_HE_EXISTS
-       )
-       != !negate;
+       );
 }
 
 /*