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.

diff --git a/cpan/Text-Tabs/t/Tabs-ElCid.t b/cpan/Text-Tabs/t/Tabs-ElCid.t
index 4208d51..32572e7 100644 (file)
--- a/cpan/Text-Tabs/t/Tabs-ElCid.t
+++ b/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;
 

diff --git a/cpan/Text-Tabs/t/Wrap-JLB.t b/cpan/Text-Tabs/t/Wrap-JLB.t
index 2c40379..67163e2 100644 (file)
--- a/cpan/Text-Tabs/t/Wrap-JLB.t
+++ b/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;
 

diff --git a/ext/XS-APItest/t/underscore_length.t b/ext/XS-APItest/t/underscore_length.t
index 7ca6906..32698f9 100644 (file)
--- a/ext/XS-APItest/t/underscore_length.t
+++ b/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;

diff --git a/op.c b/op.c
index 18afb4b..b0a3073 100644 (file)
--- a/op.c
+++ b/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 */
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1a21297..dfa9a7d 100644 (file)
--- a/pod/perldiag.pod
+++ b/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

diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 2ce9e3b..47b202a 100644 (file)
--- a/pod/perlvar.pod
+++ b/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.
 

diff --git a/t/comp/uproto.t b/t/comp/uproto.t
index d3ad19f..f81e314 100644 (file)
--- a/t/comp/uproto.t
+++ b/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' );
 }

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 2877f14..c34c22f 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/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.

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 3e9ea41..d8e43d7 100644 (file)
--- a/t/lib/warnings/op
+++ b/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

diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 477325d..7b9c1dd 100644 (file)
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -86,6 +86,7 @@ sub test_proto {
     # works in all cases.
     undef $_;
     {
+      no warnings 'deprecated';
       my $_ = $in;
       is &{"CORE::$o"}(), $out, "&$o with no args uses lexical \$_";
     }
@@ -93,6 +94,7 @@ sub test_proto {
     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 $_';

diff --git a/t/op/exec.t b/t/op/exec.t
index fb0b104..09311c5 100644 (file)
--- a/t/op/exec.t
+++ b/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' );
 }

diff --git a/t/op/mkdir.t b/t/op/mkdir.t
index ebbbd2e..6bbd100 100644 (file)
--- a/t/op/mkdir.t
+++ b/t/op/mkdir.t
@@ -48,6 +48,7 @@ ok(!-d);
 $_ = 'lfrulb';
 
 {
+    no warnings 'deprecated';
     my $_ = 'blurfl';
     ok(mkdir);
     ok(-d);

diff --git a/t/op/mydef.t b/t/op/mydef.t
index 335033b..1480ce3 100644 (file)
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use strict;
-no warnings 'misc';
+no warnings 'misc', 'deprecated';
 
 $_ = 'global';
 is($_, 'global', '$_ initial value');

diff --git a/t/op/override.t b/t/op/override.t
index 9eb22e0..e62f785 100644 (file)
--- a/t/op/override.t
+++ b/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' );

diff --git a/t/op/reverse.t b/t/op/reverse.t
index bbc9336..d4d43f8 100644 (file)
--- a/t/op/reverse.t
+++ b/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');

diff --git a/t/op/state.t b/t/op/state.t
index 65f368b..91cc4b7 100644 (file)
--- a/t/op/state.t
+++ b/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 $_';

diff --git a/t/op/switch.t b/t/op/switch.t
index 02e2cde..439df50 100644 (file)
--- a/t/op/switch.t
+++ b/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]");

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 7a38d41..2d4706a 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/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;
 

diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index d19d1df..54c2d05 100644 (file)
--- a/t/re/pat_rt_report.t
+++ b/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);

diff --git a/t/re/qr.t b/t/re/qr.t
index 1378772..ee68d63 100644 (file)
--- a/t/re/qr.t
+++ b/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/;