Add experimental lexical_subs feature

4 files changed, 52 insertions, 4 deletions

diff --git a/feature.h b/feature.h
index dc9696ec9c..215a4d5046 100644
--- a/feature.h
+++ b/feature.h
@@ -81,6 +81,12 @@
 	 FEATURE_IS_ENABLED("__SUB__")) \
     )
 
+#define FEATURE_LEXSUBS_IS_ENABLED \
+    ( \
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+	 FEATURE_IS_ENABLED("lexsubs") \
+    )
+
 #define FEATURE_UNIEVAL_IS_ENABLED \
     ( \
 	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_515 \
diff --git a/lib/feature.pm b/lib/feature.pm
index 840630ab4d..8afd53f003 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -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)],
 );
 
@@ -34,6 +35,9 @@ $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"};
+my %experimental = (
+    lexical_subs => 1,
+);
 
 our $hint_shift   = 26;
 our $hint_mask    = 0x1c000000;
@@ -362,6 +366,11 @@ sub __common {
 	if ($import) {
 	    $^H{$feature{$name}} = 1;
 	    $^H |= $hint_uni8bit if $name eq 'unicode_strings';
+	    if ($experimental{$name}) {
+		require warnings;
+		warnings::warnif("experimental:$name",
+				 "The $name feature is experimental");
+	    }
 	} else {
             delete $^H{$feature{$name}};
             $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 47e0adb402..fd09b6596e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4763,6 +4763,17 @@ think the U.S. Government thinks it's a secret, or at least that they
 will continue to pretend that it is.  And if you quote me on that, I
 will deny it.
 
+=item The %s feature is experimental
+
+(S experimental) This warning is emitted if you enable an experimental
+feature via C<use feature>.  Simply suppress the warning if you want
+to use the feature, but know that in doing so you are taking the risk
+of using an experimental feature which may change or be removed in a
+future Perl version:
+
+    no warnings "experimental:lexical_subs";
+    use feature "lexical_subs";
+
 =item The %s function is unimplemented
 
 (F) The function indicated isn't implemented on this architecture, according
diff --git a/regen/feature.pl b/regen/feature.pl
index 23a899a9ba..cc7034ee15 100755
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -28,6 +28,7 @@ my %feature = (
     evalbytes       => 'evalbytes',
     array_base      => 'arybase',
     current_sub     => '__SUB__',
+    lexical_subs    => 'lexsubs',
     unicode_eval    => 'unieval',
     unicode_strings => 'unicode',
     fc              => 'fc',
@@ -51,6 +52,8 @@ my %feature_bundle = (
 		    evalbytes current_sub fc)],
 );
 
+my @experimental = qw( lexical_subs );
+
 
 ###########################################################################
 # More data generated from the above
@@ -151,7 +154,7 @@ sub longest {
 
 print $pm "our %feature = (\n";
 my $width = length longest keys %feature;
-for(sort { length $a <=> length $b } keys %feature) {
+for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
     print $pm "    $_" . " "x($width-length)
 	    . " => 'feature_$feature{$_}',\n";
 }
@@ -172,6 +175,10 @@ for (sort keys %Aliases) {
 	qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
 };
 
+print $pm "my \%experimental = (\n";
+print $pm "    $_ => 1,\n", for @experimental;
+print $pm ");\n";
+
 print $pm <<EOPM;
 
 our \$hint_shift   = $HintShift;
@@ -251,7 +258,7 @@ print $h <<EOL;
 EOL
 
 for (
-    sort { length $a <=> length $b } keys %feature
+    sort { length $a <=> length $b || $a cmp $b } keys %feature
 ) {
     my($first,$last) =
 	map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
@@ -280,7 +287,7 @@ EOI
 
 EOH3
     }
-    else {
+    elsif ($first) {
 	print $h <<EOH4;
 #define FEATURE_$NAME\_IS_ENABLED \\
     ( \\
@@ -291,6 +298,16 @@ EOH3
 
 EOH4
     }
+    else {
+	print $h <<EOH5;
+#define FEATURE_$NAME\_IS_ENABLED \\
+    ( \\
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
+	 FEATURE_IS_ENABLED("$name") \\
+    )
+
+EOH5
+    }
 }
 
 print $h <<EOH;
@@ -647,6 +664,11 @@ sub __common {
 	if ($import) {
 	    $^H{$feature{$name}} = 1;
 	    $^H |= $hint_uni8bit if $name eq 'unicode_strings';
+	    if ($experimental{$name}) {
+		require warnings;
+		warnings::warnif("experimental:$name",
+				 "The $name feature is experimental");
+	    }
 	} else {
             delete $^H{$feature{$name}};
             $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';