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.

7 files changed, 17 insertions, 55 deletions

diff --git a/embed.fnc b/embed.fnc
index 22886ed939..27d63a9ff8 100644
--- 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 6c99c2af98..31547fbcff 100644
--- 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 6f7af31771..c9e188ba80 100644
--- 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 1bf68beb71..4dcd259dc4 100644
--- 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 5184bffaee..6e180e31a5 100644
--- 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 f4e8d1e82c..ab60389edd 100755
--- 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 286eb96f9a..8e4d9e58b9 100644
--- 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;
+	);
 }
 
 /*