Warn when declaring lexsubs, not when enabling them

feature.pm has an ":all" tag.  So if we warn when lexical subs are
enabled, then ‘use feature ":all"’ will also warn.  That’s unkind.

Instead, warn when a lexical sub is declared via
‘my/our/state sub...’.

diff --git a/lib/feature.pm b/lib/feature.pm
index 46b43a8..7654821 100644 (file)
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -35,9 +35,6 @@ $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;
@@ -233,8 +230,8 @@ 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, F<feature.pm> will
-warn when you enable the feature, unless you have explicitly disabled the
+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";
@@ -380,11 +377,6 @@ 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 1507d6d..dd1911d 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4788,16 +4788,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
+=item The lexical_subs 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:
+(S experimental::lexical_subs) This warning is emitted if you
+declare a sub with C<my> or C<state>.  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";
+    my sub foo { ... }
 
 =item The %s function is unimplemented
 

diff --git a/regen/feature.pl b/regen/feature.pl
index e1f30df..6ff2e72 100755 (executable)
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -52,6 +52,7 @@ my %feature_bundle = (
                    evalbytes current_sub fc)],
 );
 
+# not actually used currently
 my @experimental = qw( lexical_subs );
 
 
@@ -175,9 +176,9 @@ 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 "my \%experimental = (\n";
+#print $pm "    $_ => 1,\n", for @experimental;
+#print $pm ");\n";
 
 print $pm <<EOPM;
 
@@ -544,8 +545,8 @@ 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, F<feature.pm> will
-warn when you enable the feature, unless you have explicitly disabled the
+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";
@@ -678,11 +679,6 @@ 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/t/cmd/lexsub.t b/t/cmd/lexsub.t
index f52951d..86c7e26 100644 (file)
--- a/t/cmd/lexsub.t
+++ b/t/cmd/lexsub.t
@@ -206,7 +206,7 @@ package main;
   is $y, 44, 'state subs from other packages override all keywords';
 }
 {
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   state $w ;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval '#line 87 squidges
@@ -234,7 +234,7 @@ is &$sub2, 49, 'state sub in closure (2)';
 # But we need to test that state subs actually do persist from one invoca-
 # tion of a named sub to another (i.e., that they are not my subs).
 {
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   state $w;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval '#line 65 teetet
@@ -287,7 +287,7 @@ sub make_anon_with_state_sub{
 }
 {
   state sub redef {}
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   state $w;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval "#line 56 pygpyf\nsub redef {}";
@@ -428,7 +428,7 @@ package main;
   is $y, 44, 'my subs from other packages override all keywords';
 }
 {
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   my $w ;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval '#line 87 squidges
@@ -454,7 +454,7 @@ is &$sub1, 48, 'my sub in closure (1)';
 is &$sub2, 49, 'my sub in closure (2)';
 # Test that they are cloned in named subs.
 {
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   my $w;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval '#line 65 teetet
@@ -521,7 +521,7 @@ sub make_anon_with_my_sub{
 }
 {
   my sub redef {}
-  use warnings;
+  use warnings; no warnings "experimental::lexical_subs";
   my $w;
   local $SIG{__WARN__} = sub { $w .= shift };
   eval "#line 56 pygpyf\nsub redef {}";

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 01cb751..acfab57 100644 (file)
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -25,7 +25,7 @@ Missing name in "our sub" at - line 1.
 use 5.01; use feature 'lexical_subs';
 state sub;
 EXPECT
-The lexical_subs feature is experimental at - line 1.
+The lexical_subs feature is experimental at - line 2.
 Missing name in "state sub" at - line 2.
 ########
 # NAME Unterminated delimiter for here document

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 35cfb17..3e9ea41 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -788,12 +788,15 @@ sub phred { 2 };
 state sub jorge { 1 }
 sub jorge () { 2 } # should *not* produce redef warnings by default
 EXPECT
-The lexical_subs feature is experimental at - line 2.
+The lexical_subs feature is experimental at - line 3.
 Prototype mismatch: sub fred () vs none at - line 4.
 Constant subroutine fred redefined at - line 4.
+The lexical_subs feature is experimental at - line 5.
 Prototype mismatch: sub george: none vs () at - line 6.
+The lexical_subs feature is experimental at - line 7.
 Prototype mismatch: sub phred () vs none at - line 8.
 Constant subroutine phred redefined at - line 8.
+The lexical_subs feature is experimental at - line 9.
 Prototype mismatch: sub jorge: none vs () at - line 10.
 ########
 # op.c

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 0b540ec..7d66ab6 100644 (file)
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1160,13 +1160,15 @@ sub proto_after_array(@$);
 sub proto_after_hash(%$);
 sub underscore_fail($_$);
 EXPECT
-The lexical_subs feature is experimental at - line 2.
 Prototype after '@' for main::proto_after_array : @$ at - line 3.
 Prototype after '%' for main::proto_after_hash : %$ at - line 7.
 Illegal character after '_' in prototype for main::underscore_fail : $_$ at - line 12.
 Prototype after '@' for main::underscore_after_at : @_ at - line 13.
+The lexical_subs feature is experimental at - line 14.
 Prototype after '@' for hour : @$ at - line 14.
+The lexical_subs feature is experimental at - line 15.
 Prototype after '@' for migh : @$ at - line 15.
+The lexical_subs feature is experimental at - line 17.
 Prototype after '@' for estate : @$ at - line 17.
 Prototype after '@' for hour : @$ at - line 19.
 Prototype after '@' for migh : @$ at - line 20.

diff --git a/t/porting/diag.t b/t/porting/diag.t
index 4dcdf3b..a060268 100644 (file)
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -78,7 +78,7 @@ my $cur_entry;
 open my $diagfh, "<", $pod
   or die "Can't open $pod: $!";
 
-my $category_re = qr/ [a-z0-9_]+?/;      # Note: requires an initial space
+my $category_re = qr/ [a-z0-9_:]+?/;    # Note: requires an initial space
 my $severity_re = qr/ . (?: \| . )* /x; # A severity is a single char, but can
                                         # be of the form 'S|P|W'
 my @same_descr;
@@ -296,6 +296,7 @@ sub check_file {
                  :                                '[PFX]';
     my $categories;
     if (defined $category) {
+      $category =~ s/__/::/g;
       $categories =
         join ", ",
               sort map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category;

diff --git a/toke.c b/toke.c
index 32367bc..9ae733c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8022,6 +8022,9 @@ Perl_yylex(pTHX)
                                  "Experimental \"%s\" subs not enabled",
                                   tmp == KEY_my    ? "my"    :
                                   tmp == KEY_state ? "state" : "our");
+                   Perl_ck_warner_d(aTHX_
+                       packWARN(WARN_EXPERIMENTAL__LEXICAL_SUBS),
+                       "The lexical_subs feature is experimental");
                    goto really_sub;
                }
                PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);