From 90b58ec9e4b2574a8f7f11a0215f42453cfbc0a1 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 4 Dec 2012 09:53:55 -0800 Subject: [PATCH] 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 | 3 ++- cpan/Text-Tabs/t/Wrap-JLB.t | 3 ++- ext/XS-APItest/t/underscore_length.t | 2 +- op.c | 7 +++++++ pod/perldiag.pod | 12 ++++++++++++ pod/perlvar.pod | 3 ++- t/comp/uproto.t | 8 ++++++++ t/lib/warnings/9uninit | 1 + t/lib/warnings/op | 14 ++++++++++++++ t/op/coreamp.t | 4 ++++ t/op/exec.t | 1 + t/op/mkdir.t | 1 + t/op/mydef.t | 2 +- t/op/override.t | 1 + t/op/reverse.t | 1 + t/op/state.t | 1 + t/op/switch.t | 7 +++++++ t/re/pat_advanced.t | 3 ++- t/re/pat_rt_report.t | 1 + t/re/qr.t | 1 + 20 files changed, 70 insertions(+), 6 deletions(-) diff --git a/cpan/Text-Tabs/t/Tabs-ElCid.t b/cpan/Text-Tabs/t/Tabs-ElCid.t index 4208d51..32572e7 100644 --- 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 $_ = ) { + while ( ) { 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 --- 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 $_ = ) { + local $_; + while ( ) { 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 --- 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 --- 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 --- 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. Use a filename instead. +=item Use of my $_ is deprecated + +(D deprecated) Lexical $_ is deprecated because of +its confusing side-effects. Consider using C +instead. See the explanation under L. + =item Use of %s on a handle without * is deprecated (D deprecated) You used C, C or C 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 +instead. See the explanation under L. + =item Use of tainted arguments in %s is deprecated (W taint, deprecated) You have supplied C or C with multiple diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 2ce9e3b..47b202a 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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"; /(?a)|(?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 (?\S+)/x; diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index d19d1df..54c2d05 100644 --- 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 --- 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/; -- 2.7.4