Deprecate lexical $_

See tickets #114020 and #75598 for why.

The changes to tests in cpan/Text-Tabs have been submitted upstream
at rt.cpan.org #81698.

cpan/Text-Tabs/t/Tabs-ElCid.t

@@ -105,8 +105,9 @@ sub check($$$$) {
 
 sub check_data { 
 
+    local $_;
     binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
-    while ( my $_ = <DATA> ) {
+    while ( <DATA> ) {
 
 	my $bad = 0;
 

cpan/Text-Tabs/t/Wrap-JLB.t

@@ -87,7 +87,8 @@ sub check($$$$) {
 sub check_data { 
 
     binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
-    while ( my $_ = <DATA> ) {
+    local $_;
+    while ( <DATA> ) {
 
 	my $bad = 0;
 

ext/XS-APItest/t/underscore_length.t

@@ -1,4 +1,4 @@
-use warnings;
+use warnings; no warnings 'deprecated';
 use strict;
 
 use Test::More tests => 4;

op.c

@@ -578,6 +578,13 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 			      PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
 	}
     }
+    else if (len == 2 && name[1] == '_' && !is_our)
+	/* diag_listed_as: Use of my $_ is deprecated */
+	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+			      "Use of %s $_ is deprecated",
+			       PL_parser->in_my == KEY_state
+				 ? "state"
+				 : "my");
 
     /* allocate a spare slot and store the name in that slot */
 

pod/perldiag.pod

@@ -5585,6 +5585,12 @@ old way has bad side effects.
 it already went past any symlink you are presumably trying to look for.
 The operation returned C<undef>.  Use a filename instead.
 
+=item Use of my $_ is deprecated
+
+(D deprecated) Lexical $_ is deprecated because of
+its confusing side-effects.  Consider using C<local $_>
+instead.  See the explanation under L<perlvar/$_>.
+
 =item Use of %s on a handle without * is deprecated
 
 (D deprecated) You used C<tie>, C<tied> or C<untie> on a scalar but that scalar
@@ -5616,6 +5622,12 @@ C<$array[0+$ref]>.  This warning is not given for overloaded objects,
 however, because you can overload the numification and stringification
 operators and then you presumably know what you are doing.
 
+=item Use of state $_ is deprecated
+
+(D deprecated) Lexical $_ is deprecated because of
+its confusing side-effects.  Consider using C<local $_>
+instead.  See the explanation under L<perlvar/$_>.
+
 =item Use of tainted arguments in %s is deprecated
 
 (W taint, deprecated) You have supplied C<system()> or C<exec()> with multiple

pod/perlvar.pod

@@ -155,7 +155,8 @@ actually causes more problems than it solves.  If you call a function that
 expects to be passed information via C<$_>, it may or may not work,
 depending on how the function is written, there not being any easy way to
 solve this.  Just avoid lexical C<$_>, unless you are feeling particularly
-masochistic.
+masochistic.  For this reason lexical C<$_> is deprecated and will produce
+a warning unless warnings have been disabled.
 
 Mnemonic: underline is understood in certain operations.
 

t/comp/uproto.t

@@ -72,7 +72,11 @@ eval q{ f(1,2,3,4) };
 like( $@, qr/Too many arguments for main::f at/ );
 
 {
+    # We have not tested require/use/no yet, so we must avoid this:
+    #    no warnings 'deprecated';
+    BEGIN { $SIG{__WARN__} = sub {} }
     my $_ = "quarante-deux";
+    BEGIN { $SIG{__WARN__} = undef }
     $foo = "FOO";
     $bar = "BAR";
     f("FOO quarante-deux", $foo);
@@ -97,7 +101,9 @@ $_ = $expected;
 g();
 g;
 undef $expected; &g; # $_ not passed
+BEGIN { $SIG{__WARN__} = sub {} }
 { $expected = my $_ = "bar"; g() }
+BEGIN { $SIG{__WARN__} = undef }
 
 eval q{ sub wrong1 (_$); wrong1(1,2) };
 like( $@, qr/Malformed prototype for main::wrong1/, 'wrong1' );
@@ -142,7 +148,9 @@ $_ = 21;
 double();
 is( $_, 42, '$_ is modifiable' );
 {
+    BEGIN { $SIG{__WARN__} = sub {} }
     my $_ = 22;
+    BEGIN { $SIG{__WARN__} = undef }
     double();
     is( $_, 44, 'my $_ is modifiable' );
 }

t/lib/warnings/9uninit

@@ -820,6 +820,7 @@ undef $g1;
 $m1 = '$g1';
 $foo =~ s//$m1/ee;
 EXPECT
+Use of my $_ is deprecated at - line 16.
 Use of uninitialized value $_ in pattern match (m//) at - line 5.
 Use of uninitialized value $m1 in regexp compilation at - line 6.
 Use of uninitialized value $_ in pattern match (m//) at - line 6.

t/lib/warnings/op

@@ -1,5 +1,8 @@
   op.c		AOK
 
+     Use of my $_ is deprecated
+	my $_ ;
+
      Found = in conditional, should be ==
 	1 if $a = 1 ;
 
@@ -104,6 +107,17 @@
 
 __END__
 # op.c
+use warnings 'deprecated' ;
+my $_;
+CORE::state $_;
+no warnings 'deprecated' ;
+my $_;
+CORE::state $_;
+EXPECT
+Use of my $_ is deprecated at - line 3.
+Use of state $_ is deprecated at - line 4.
+########
+# op.c
 use warnings 'syntax' ;
 1 if $a = 1 ;
 1 if $a

t/op/coreamp.t

@@ -86,13 +86,15 @@ sub test_proto {
     # works in all cases.
     undef $_;
     {
+      no warnings 'deprecated';
       my $_ = $in;
       is &{"CORE::$o"}(), $out, "&$o with no args uses lexical \$_";
     }
     # Make sure we get the right pad under recursion
     my $r;
     $r = sub {
       if($_[0]) {
+        no warnings 'deprecated';
         my $_ = $in;
         is &{"CORE::$o"}(), $out,
            "&$o with no args uses the right lexical \$_ under recursion";
@@ -102,6 +104,7 @@ sub test_proto {
       }
     };
     &$r(0);
+    no warnings 'deprecated';
     my $_ = $in;
     eval {
        is "CORE::$o"->(), $out, "&$o with the right lexical \$_ in an eval"
@@ -1013,6 +1016,7 @@ like $@, qr'^Undefined format "STDOUT" called',
   my $warnings;
   local $SIG{__WARN__} = sub { ++$warnings };
 
+  no warnings 'deprecated';
   my $_ = 'Phoo';
   ok &mymkdir(), '&mkdir';
   like <*>, qr/^phoo(.DIR)?\z/i, 'mkdir works with implicit $_';

t/op/exec.t

@@ -124,6 +124,7 @@ $Perl -le "print 'ok'"
 END
 
 {
+    no warnings 'deprecated';
     my $_ = qq($Perl -le "print 'ok'");
     is( readpipe, "ok\n", 'readpipe default argument' );
 }

t/op/mkdir.t

@@ -48,6 +48,7 @@ ok(!-d);
 $_ = 'lfrulb';
 
 {
+    no warnings 'deprecated';
     my $_ = 'blurfl';
     ok(mkdir);
     ok(-d);

t/op/mydef.t

@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use strict;
-no warnings 'misc';
+no warnings 'misc', 'deprecated';
 
 $_ = 'global';
 is($_, 'global', '$_ initial value');

t/op/override.t

@@ -63,6 +63,7 @@ is( $r, join($dirsep, "Foo", "Bar.pm") );
 }
 
 {
+    no warnings 'deprecated';
     my $_ = 'bar.pm';
     require;
     is( $r, 'bar.pm' );

t/op/reverse.t

@@ -94,6 +94,7 @@ use Tie::Array;
 
 {
     # Lexical $_.
+    no warnings 'deprecated';
     sub blurp { my $_ = shift; reverse }
 
     is(blurp("foo"), "oof", 'reversal of default variable in function');

t/op/state.t

@@ -211,6 +211,7 @@ my $first  = $stones [0];
 my $First  = ucfirst $first;
 $_ = "bambam";
 foreach my $flint (@stones) {
+    no warnings 'deprecated';
     state $_ = $flint;
     is $_, $first, 'state $_';
     ok /$first/, '/.../ binds to $_';

t/op/switch.t

@@ -55,6 +55,7 @@ given("inside") { check_outside1() }
 sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
 
 {
+    no warnings 'deprecated';
     my $_ = "outside";
     given("inside") { check_outside2() }
     sub check_outside2 {
@@ -397,6 +398,7 @@ sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
 
 # Make sure it still works with a lexical $_:
 {
+    no warnings 'deprecated';
     my $_;
     my $test = "explicit comparison with lexical \$_";
     my $twenty_five = 25;
@@ -697,6 +699,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'deprecated';
     my $_;
     for (1, "two") {
 	when ("two") {
@@ -715,6 +718,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'deprecated';
     my $_;
     for $_ (1, "two") {
 	when ("two") {
@@ -733,6 +737,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'deprecated';
     for my $_ (1, "two") {
 	when ("two") {
 	    is($first, 0, "Lexical loop: second");
@@ -1366,6 +1371,7 @@ unreified_check(undef,"");
 
 {
     sub f1 {
+	no warnings 'deprecated';
 	my $_;
 	given(3) {
 	    return sub { $_ } # close over lexical $_
@@ -1379,6 +1385,7 @@ unreified_check(undef,"");
     sub DESTROY { $d++ };
 
     sub f2 {
+	no warnings 'deprecated';
 	my $_ = 5;
 	given(bless [7]) {
 	    ::is($_->[0], 7, "is [7]");

t/re/pat_advanced.t

@@ -1615,7 +1615,7 @@ sub run_tests {
     {
         # Test for keys in %+ and %-
         my $message = 'Test keys in %+ and %-';
-        no warnings 'uninitialized';
+        no warnings 'uninitialized', 'deprecated';
         my $_ = "abcdef";
         /(?<foo>a)|(?<foo>b)/;
         is((join ",", sort keys %+), "foo", $message);
@@ -1636,6 +1636,7 @@ sub run_tests {
 
     {
         # length() on captures, the numbered ones end up in Perl_magic_len
+        no warnings 'deprecated';
         my $_ = "aoeu \xe6var ook";
         /^ \w+ \s (?<eek>\S+)/x;
 

t/re/pat_rt_report.t

@@ -915,6 +915,7 @@ sub run_tests {
     {
          my $message = '$REGMARK in replacement; Bug 49190';
          our $REGMARK;
+         no warnings 'deprecated';
          my $_ = "A";
          ok(s/(*:B)A/$REGMARK/, $message);
          is($_, "B", $message);

t/re/qr.t

@@ -33,6 +33,7 @@ is(ref $rx, "Regexp", "qr// blessed into 'Regexp' by default");
 
  is $output, "5\n1: 5\n2: 5\n", '$a_match_var =~ /$qr/';
 }
+no warnings 'deprecated';
 for my $_($'){
  my $output = '';
  my $rx = qr/o/;