summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2015-08-19 13:10:16 -0700
committerRicardo Signes <rjbs@cpan.org>2015-09-29 10:49:19 -0400
commit7fba29668402ec06ad00dfafda69913bcbb2c1df (patch)
tree70b3e0d3f06e47f23571ce6f95c09991ee83b39b /t
parent96f902ff649ca0f75966f5282611d16ecf5f907e (diff)
downloadperl-7fba29668402ec06ad00dfafda69913bcbb2c1df.tar.gz
Disable lexical $_
This just disables the syntax and modifes the tests. The underlying infrastructure has not been removed yet. I had to change a couple of tests in cpan/.
Diffstat (limited to 't')
-rw-r--r--t/comp/uproto.t31
-rw-r--r--t/lib/warnings/9uninit82
-rw-r--r--t/lib/warnings/op14
-rw-r--r--t/op/coreamp.t33
-rw-r--r--t/op/exec.t3
-rw-r--r--t/op/mkdir.t12
-rw-r--r--t/op/mydef.t208
-rw-r--r--t/op/override.t13
-rw-r--r--t/op/reverse.t15
-rw-r--r--t/op/signatures.t18
-rw-r--r--t/op/state.t18
-rw-r--r--t/op/switch.t95
-rw-r--r--t/re/pat_advanced.t6
-rw-r--r--t/re/pat_rt_report.t3
-rw-r--r--t/re/qr.t22
15 files changed, 43 insertions, 530 deletions
diff --git a/t/comp/uproto.t b/t/comp/uproto.t
index f81e31411c..9db6d54644 100644
--- a/t/comp/uproto.t
+++ b/t/comp/uproto.t
@@ -1,6 +1,6 @@
#!perl
-print "1..43\n";
+print "1..32\n";
my $test = 0;
sub failed {
@@ -71,25 +71,6 @@ like( $@, qr/Not enough arguments for main::f at/ );
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);
- f("BAR quarante-deux", $bar);
- f("y quarante-deux", substr("xy",1,1));
- f("1 quarante-deux", ("abcdef" =~ /abc/));
- f("not undef quarante-deux", $undef || "not undef");
- f(" quarante-deux", -f "no_such_file");
- f("FOOBAR quarante-deux", ($foo . $bar));
- f("FOOBAR quarante-deux", ($foo .= $bar));
- f("FOOBAR quarante-deux", $foo);
-}
-
&f(""); # no error
sub g(_) { is(shift, $expected) }
@@ -101,9 +82,6 @@ $_ = $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' );
@@ -147,10 +125,3 @@ sub double(_) { $_[0] *= 2 }
$_ = 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 d26d6ca0ba..ef9b4f6d17 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -786,17 +786,6 @@ s/$m1/$g1/; undef $_;
tr/x/y/; undef $_;
tr/x/y/r; undef $_;
-my $_;
-/y/;
-/$m1/;
-/$g1/;
-s/y/z/; undef $_;
-s/$m1/z/; undef $_;
-s//$g1/; undef $_;
-s/$m1/$g1/; undef $_;
-tr/x/y/; undef $_;
-tr/x/y/r; undef $_;
-
$g2 =~ /y/;
$g2 =~ /$m1/;
$g2 =~ /$g1/;
@@ -822,7 +811,6 @@ undef $m1;
$m1 =~ tr/x/y/; undef $m1;
$m1 =~ tr/x/y/r;
EXPECT
-Use of my $_ is experimental 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.
@@ -841,52 +829,34 @@ Use of uninitialized value $_ in substitution (s///) at - line 12.
Use of uninitialized value $g1 in substitution iterator at - line 12.
Use of uninitialized value $_ in transliteration (tr///) at - line 13.
Use of uninitialized value $_ in transliteration (tr///) at - line 14.
-Use of uninitialized value $_ in pattern match (m//) at - line 17.
-Use of uninitialized value $m1 in regexp compilation at - line 18.
-Use of uninitialized value $_ in pattern match (m//) at - line 18.
-Use of uninitialized value $g1 in regexp compilation at - line 19.
-Use of uninitialized value $_ in pattern match (m//) at - line 19.
-Use of uninitialized value $_ in substitution (s///) at - line 20.
-Use of uninitialized value $m1 in regexp compilation at - line 21.
-Use of uninitialized value $_ in substitution (s///) at - line 21.
-Use of uninitialized value $_ in substitution (s///) at - line 21.
-Use of uninitialized value $_ in substitution (s///) at - line 22.
-Use of uninitialized value $_ in substitution (s///) at - line 22.
+Use of uninitialized value $g2 in pattern match (m//) at - line 16.
+Use of uninitialized value $m1 in regexp compilation at - line 17.
+Use of uninitialized value $g2 in pattern match (m//) at - line 17.
+Use of uninitialized value $g1 in regexp compilation at - line 18.
+Use of uninitialized value $g2 in pattern match (m//) at - line 18.
+Use of uninitialized value $g2 in substitution (s///) at - line 19.
+Use of uninitialized value $m1 in regexp compilation at - line 20.
+Use of uninitialized value $g2 in substitution (s///) at - line 20.
+Use of uninitialized value $g2 in substitution (s///) at - line 20.
+Use of uninitialized value $g2 in substitution (s///) at - line 21.
+Use of uninitialized value $g2 in substitution (s///) at - line 21.
+Use of uninitialized value $g1 in substitution iterator at - line 21.
+Use of uninitialized value $m1 in regexp compilation at - line 22.
+Use of uninitialized value $g2 in substitution (s///) at - line 22.
+Use of uninitialized value $g2 in substitution (s///) at - line 22.
Use of uninitialized value $g1 in substitution iterator at - line 22.
-Use of uninitialized value $m1 in regexp compilation at - line 23.
-Use of uninitialized value $_ in substitution (s///) at - line 23.
-Use of uninitialized value $_ in substitution (s///) at - line 23.
-Use of uninitialized value $g1 in substitution iterator at - line 23.
-Use of uninitialized value $_ in transliteration (tr///) at - line 24.
-Use of uninitialized value $_ in transliteration (tr///) at - line 25.
-Use of uninitialized value $g2 in pattern match (m//) at - line 27.
-Use of uninitialized value $m1 in regexp compilation at - line 28.
-Use of uninitialized value $g2 in pattern match (m//) at - line 28.
-Use of uninitialized value $g1 in regexp compilation at - line 29.
-Use of uninitialized value $g2 in pattern match (m//) at - line 29.
-Use of uninitialized value $g2 in substitution (s///) at - line 30.
-Use of uninitialized value $m1 in regexp compilation at - line 31.
-Use of uninitialized value $g2 in substitution (s///) at - line 31.
-Use of uninitialized value $g2 in substitution (s///) at - line 31.
-Use of uninitialized value $g2 in substitution (s///) at - line 32.
-Use of uninitialized value $g2 in substitution (s///) at - line 32.
+Use of uninitialized value in transliteration (tr///) at - line 23.
+Use of uninitialized value in transliteration (tr///) at - line 24.
+Use of uninitialized value $m1 in regexp compilation at - line 27.
+Use of uninitialized value $g1 in regexp compilation at - line 28.
+Use of uninitialized value $m1 in regexp compilation at - line 30.
+Use of uninitialized value $g1 in substitution iterator at - line 31.
+Use of uninitialized value $m1 in regexp compilation at - line 32.
Use of uninitialized value $g1 in substitution iterator at - line 32.
-Use of uninitialized value $m1 in regexp compilation at - line 33.
-Use of uninitialized value $g2 in substitution (s///) at - line 33.
-Use of uninitialized value $g2 in substitution (s///) at - line 33.
-Use of uninitialized value $g1 in substitution iterator at - line 33.
-Use of uninitialized value in transliteration (tr///) at - line 34.
-Use of uninitialized value in transliteration (tr///) at - line 35.
-Use of uninitialized value $m1 in regexp compilation at - line 38.
-Use of uninitialized value $g1 in regexp compilation at - line 39.
-Use of uninitialized value $m1 in regexp compilation at - line 41.
-Use of uninitialized value $g1 in substitution iterator at - line 42.
-Use of uninitialized value $m1 in regexp compilation at - line 43.
-Use of uninitialized value $g1 in substitution iterator at - line 43.
-Use of uninitialized value $m1 in substitution (s///) at - line 44.
-Use of uninitialized value in substitution iterator at - line 47.
-Use of uninitialized value $m1 in transliteration (tr///) at - line 49.
-Use of uninitialized value $m1 in transliteration (tr///) at - line 50.
+Use of uninitialized value $m1 in substitution (s///) at - line 33.
+Use of uninitialized value in substitution iterator at - line 36.
+Use of uninitialized value $m1 in transliteration (tr///) at - line 38.
+Use of uninitialized value $m1 in transliteration (tr///) at - line 39.
########
use warnings 'uninitialized';
my ($m1);
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index d2f8e577d2..b253741c5e 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1,8 +1,5 @@
op.c AOK
- Use of my $_ is experimental
- my $_ ;
-
Found = in conditional, should be ==
1 if $a = 1 ;
@@ -105,17 +102,6 @@
__END__
# op.c
-use warnings 'experimental::lexical_topic' ;
-my $_;
-CORE::state $_;
-no warnings 'experimental::lexical_topic' ;
-my $_;
-CORE::state $_;
-EXPECT
-Use of my $_ is experimental at - line 3.
-Use of state $_ is experimental 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 b6c94875e5..7a991551a3 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -71,7 +71,7 @@ sub test_proto {
if (!@_) { return }
- $tests += 6;
+ $tests += 3;
my($in,$out) = @_; # for testing implied $_
@@ -83,34 +83,6 @@ sub test_proto {
$_ = $in;
is &{"CORE::$o"}(), $out, "&$o with no args";
-
- # Since there is special code to deal with lexical $_, make sure it
- # works in all cases.
- undef $_;
- {
- no warnings 'experimental::lexical_topic';
- 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 'experimental::lexical_topic';
- my $_ = $in;
- is &{"CORE::$o"}(), $out,
- "&$o with no args uses the right lexical \$_ under recursion";
- }
- else {
- &$r(1)
- }
- };
- &$r(0);
- no warnings 'experimental::lexical_topic';
- my $_ = $in;
- eval {
- is "CORE::$o"->(), $out, "&$o with the right lexical \$_ in an eval"
- };
}
elsif ($p =~ '^;([$*]+)\z') { # ;$ ;* ;$$ etc.
my $maxargs = length $1;
@@ -1062,8 +1034,7 @@ like $@, qr'^Undefined format "STDOUT" called',
my $warnings;
local $SIG{__WARN__} = sub { ++$warnings };
- no warnings 'experimental::lexical_topic';
- my $_ = 'Phoo';
+ local $_ = '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 6ec3646c4d..325ccb2ace 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -124,8 +124,7 @@ $Perl -le "print 'ok'"
END
{
- no warnings 'experimental::lexical_topic';
- my $_ = qq($Perl -le "print 'ok'");
+ local $_ = 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 35e477306c..d37acc62fa 100644
--- a/t/op/mkdir.t
+++ b/t/op/mkdir.t
@@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 22;
+plan tests => 17;
unless (eval {
require File::Path;
@@ -58,13 +58,3 @@ ok(-d);
ok(rmdir);
ok(!-d);
$_ = 'lfrulb';
-
-{
- no warnings 'experimental::lexical_topic';
- my $_ = 'blurfl';
- ok(mkdir);
- ok(-d);
- ok(-d 'blurfl');
- ok(!-d 'lfrulb');
- ok(rmdir);
-}
diff --git a/t/op/mydef.t b/t/op/mydef.t
index b993f1b607..11b55dd69e 100644
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -7,212 +7,8 @@ BEGIN {
}
use strict;
-no warnings 'misc', 'experimental::lexical_topic';
-$_ = 'global';
-is($_, 'global', '$_ initial value');
-s/oba/abo/;
-is($_, 'glabol', 's/// on global $_');
-
-{
- my $_ = 'local';
- is($_, 'local', 'my $_ initial value');
- s/oca/aco/;
- is($_, 'lacol', 's/// on my $_');
- /(..)/;
- is($1, 'la', '// on my $_');
- cmp_ok(tr/c/d/, '==', 1, 'tr/// on my $_ counts correctly' );
- is($_, 'ladol', 'tr/// on my $_');
- {
- my $_ = 'nested';
- is($_, 'nested', 'my $_ nested');
- chop;
- is($_, 'neste', 'chop on my $_');
- }
- {
- our $_;
- is($_, 'glabol', 'gains access to our global $_');
- }
- is($_, 'ladol', 'my $_ restored');
-}
-is($_, 'glabol', 'global $_ restored');
-s/abo/oba/;
-is($_, 'global', 's/// on global $_ again');
-{
- my $_ = 11;
- our $_ = 22;
- is($_, 22, 'our $_ is seen explicitly');
- chop;
- is($_, 2, '...default chop chops our $_');
- /(.)/;
- is($1, 2, '...default match sees our $_');
-}
-
-$_ = "global";
-{
- my $_ = 'local';
- for my $_ ("foo") {
- is($_, "foo", 'for my $_');
- /(.)/;
- is($1, "f", '...m// in for my $_');
- is(our $_, 'global', '...our $_ inside for my $_');
- }
- is($_, 'local', '...my $_ restored outside for my $_');
- is(our $_, 'global', '...our $_ restored outside for my $_');
-}
-{
- my $_ = 'local';
- for ("implicit foo") { # implicit "my $_"
- is($_, "implicit foo", 'for implicit my $_');
- /(.)/;
- is($1, "i", '...m// in for implicit my $_');
- is(our $_, 'global', '...our $_ inside for implicit my $_');
- }
- is($_, 'local', '...my $_ restored outside for implicit my $_');
- is(our $_, 'global', '...our $_ restored outside for implicit my $_');
-}
-{
- my $_ = 'local';
- is($_, "postfix foo", 'postfix for' ) for 'postfix foo';
- is($_, 'local', '...my $_ restored outside postfix for');
- is(our $_, 'global', '...our $_ restored outside postfix for');
-}
-{
- for our $_ ("bar") {
- is($_, "bar", 'for our $_');
- /(.)/;
- is($1, "b", '...m// in for our $_');
- }
- is($_, 'global', '...our $_ restored outside for our $_');
-}
-
-{
- my $buf = '';
- sub tmap1 { /(.)/; $buf .= $1 } # uses our $_
- my $_ = 'x';
- sub tmap2 { /(.)/; $buf .= $1 } # uses my $_
- map {
- tmap1();
- tmap2();
- ok( /^[67]\z/, 'local lexical $_ is seen in map' );
- { is(our $_, 'global', 'our $_ still visible'); }
- ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' );
- { my $_ ; is($_, undef, 'nested my $_ is undefined'); }
- } 6, 7;
- is($buf, 'gxgx', q/...map doesn't modify outer lexical $_/);
- is($_, 'x', '...my $_ restored outside map');
- is(our $_, 'global', '...our $_ restored outside map');
- map { my $_; is($_, undef, 'redeclaring $_ in map block undefs it'); } 1;
-}
-{ map { my $_; is($_, undef, 'declaring $_ in map block undefs it'); } 1; }
-{
- sub tmap3 () { return $_ };
- my $_ = 'local';
- sub tmap4 () { return $_ };
- my $x = join '-', map $_.tmap3.tmap4, 1 .. 2;
- is($x, '1globallocal-2globallocal', 'map without {}');
-}
-{
- for my $_ (1) {
- my $x = map $_, qw(a b);
- is($x, 2, 'map in scalar context');
- }
-}
-{
- my $buf = '';
- sub tgrep1 { /(.)/; $buf .= $1 }
- my $_ = 'y';
- sub tgrep2 { /(.)/; $buf .= $1 }
- grep {
- tgrep1();
- tgrep2();
- ok( /^[89]\z/, 'local lexical $_ is seen in grep' );
- { is(our $_, 'global', 'our $_ still visible'); }
- ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' );
- } 8, 9;
- is($buf, 'gygy', q/...grep doesn't modify outer lexical $_/);
- is($_, 'y', '...my $_ restored outside grep');
- is(our $_, 'global', '...our $_ restored outside grep');
-}
-{
- sub tgrep3 () { return $_ };
- my $_ = 'local';
- sub tgrep4 () { return $_ };
- my $x = join '-', grep $_=$_.tgrep3.tgrep4, 1 .. 2;
- is($x, '1globallocal-2globallocal', 'grep without {} with side-effect');
- is($_, 'local', '...but without extraneous side-effects');
-}
-{
- for my $_ (1) {
- my $x = grep $_, qw(a b);
- is($x, 2, 'grep in scalar context');
- }
-}
-{
- my $s = "toto";
- my $_ = "titi";
- my $r;
- {
- local $::TODO = 'Marked as todo since test was added in 59f00321bbc2d046';
- $r = $s =~ /to(?{ is($_, 'toto', 'my $_ in code-match' ) })to/;
- }
- ok($r, "\$s=$s should match!");
- is(our $_, 'global', '...our $_ restored outside code-match');
-}
-
-{
- my $_ = "abc";
- my $x = reverse;
- is($x, "cba", 'reverse without arguments picks up $_');
-}
-
-{
- package notmain;
- our $_ = 'notmain';
- ::is($::_, 'notmain', 'our $_ forced into main::');
- /(.*)/;
- ::is($1, 'notmain', '...m// defaults to our $_ in main::');
-}
-
-my $file = tempfile();
-{
- open my $_, '>', $file or die "Can't open $file: $!";
- print $_ "hello\n";
- close $_;
- cmp_ok(-s $file, '>', 5, 'writing to filehandle $_ works');
-}
-{
- open my $_, $file or die "Can't open $file: $!";
- my $x = <$_>;
- is($x, "hello\n", 'reading from <$_> works');
- close $_;
-}
-
-{
- $fqdb::_ = 'fqdb';
- is($fqdb::_, 'fqdb', 'fully qualified $_ is not in main' );
- is(eval q/$fqdb::_/, 'fqdb', 'fully qualified, evaled $_ is not in main' );
- package fqdb;
- ::isnt($_, 'fqdb', 'unqualified $_ is in main' );
- ::isnt(eval q/$_/, 'fqdb', 'unqualified, evaled $_ is in main');
-}
-
-{
- $clank_est::qunckkk = 3;
- our $qunckkk;
- $qunckkk = 4;
- package clank_est;
- our $qunckkk;
- ::is($qunckkk, 3, 'regular variables are not forced to main');
-}
-
-{
- $whack::_ = 3;
- our $_;
- $_ = 4;
- package whack;
- our $_;
- ::is($_, 4, '$_ is "special", and always forced to main');
-}
+eval 'my $_';
+like $@, qr/^Can't use global \$_ in "my" at /;
done_testing();
diff --git a/t/op/override.t b/t/op/override.t
index ff4357175a..e660311e90 100644
--- a/t/op/override.t
+++ b/t/op/override.t
@@ -8,7 +8,7 @@ BEGIN {
require 'Config_heavy.pl'; # since runperl will need them
}
-plan tests => 37;
+plan tests => 36;
#
# This file tries to test builtin override using CORE::GLOBAL
@@ -64,17 +64,6 @@ is( $r, join($dirsep, "Foo", "Bar.pm") );
is( $r, 'foo.pm' );
}
-{
- BEGIN {
- # Can’t do ‘no warnings’ with CORE::GLOBAL::require overridden. :-)
- CORE::require warnings;
- unimport warnings 'experimental::lexical_topic';
- }
- my $_ = 'bar.pm';
- require;
- is( $r, 'bar.pm' );
-}
-
# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
{
local(*CORE::GLOBAL::require);
diff --git a/t/op/reverse.t b/t/op/reverse.t
index 059ece2fa0..74e6295446 100644
--- a/t/op/reverse.t
+++ b/t/op/reverse.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 26;
+plan tests => 23;
is(reverse("abc"), "cba", 'simple reverse');
@@ -91,16 +91,3 @@ use Tie::Array;
my $c = scalar reverse($b);
is($a, $c, 'Unicode string double reversal matches original');
}
-
-{
- # Lexical $_.
- no warnings 'experimental::lexical_topic';
- sub blurp { my $_ = shift; reverse }
-
- is(blurp("foo"), "oof", 'reversal of default variable in function');
- is(sub { my $_ = shift; reverse }->("bar"), "rab", 'reversal of default variable in anonymous function');
- {
- local $_ = "XXX";
- is(blurp("paz"), "zap", 'reversal of default variable with local value set' );
- }
-}
diff --git a/t/op/signatures.t b/t/op/signatures.t
index e1c3140fd8..217efa3add 100644
--- a/t/op/signatures.t
+++ b/t/op/signatures.t
@@ -1091,24 +1091,6 @@ like $@, qr/\AParse error at foo line 8\.\n/;
eval "#line 8 foo\nsub t099 (\$\$) { }";
like $@, qr/\AParse error at foo line 8\.\n/;
-no warnings "experimental::lexical_topic";
-sub t100 ($_) { "$::_/$_" }
-is prototype(\&t100), undef;
-$_ = "___";
-is eval("t100()"), undef;
-like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
-$_ = "___";
-is eval("t100(0)"), "___/0";
-$_ = "___";
-is eval("t100(456)"), "___/456";
-$_ = "___";
-is eval("t100(456, 789)"), undef;
-like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
-$_ = "___";
-is eval("t100(456, 789, 987)"), undef;
-like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
-is $a, 123;
-
eval "#line 8 foo\nsub t101 (\@_) { }";
like $@, qr/\ACan't use global \@_ in "my" at foo line 8/;
diff --git a/t/op/state.t b/t/op/state.t
index 81e5486867..ed68b515aa 100644
--- a/t/op/state.t
+++ b/t/op/state.t
@@ -9,7 +9,7 @@ BEGIN {
use strict;
-plan tests => 137;
+plan tests => 124;
# Before loading feature.pm, test it with CORE::
ok eval 'CORE::state $x = 1;', 'CORE::state outside of feature.pm scope';
@@ -204,22 +204,6 @@ $y = 0;
#
-# Check state $_
-#
-my @stones = qw [fred wilma barny betty];
-my $first = $stones [0];
-my $First = ucfirst $first;
-$_ = "bambam";
-foreach my $flint (@stones) {
- no warnings 'experimental::lexical_topic';
- state $_ = $flint;
- is $_, $first, 'state $_';
- ok /$first/, '/.../ binds to $_';
- is ucfirst, $First, '$_ default argument';
-}
-is $_, "bambam", '$_ is still there';
-
-#
# Goto.
#
my @simpsons = qw [Homer Marge Bart Lisa Maggie];
diff --git a/t/op/switch.t b/t/op/switch.t
index 204a57a999..d8cae7de8c 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -10,7 +10,7 @@ use strict;
use warnings;
no warnings 'experimental::smartmatch';
-plan tests => 201;
+plan tests => 189;
# The behaviour of the feature pragma should be tested by lib/feature.t
# using the tests in t/lib/feature/*. This file tests the behaviour of
@@ -55,15 +55,6 @@ $_ = "outside";
given("inside") { check_outside1() }
sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
-{
- no warnings 'experimental::lexical_topic';
- my $_ = "outside";
- given("inside") { check_outside2() }
- sub check_outside2 {
- is($_, "outside", "\$_ lexically scoped (lexical \$_)")
- }
-}
-
# Basic string/numeric comparisons and control flow
{
@@ -397,23 +388,6 @@ sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
is($ok, "twenty", $test);
}
-# Make sure it still works with a lexical $_:
-{
- no warnings 'experimental::lexical_topic';
- my $_;
- my $test = "explicit comparison with lexical \$_";
- my $twenty_five = 25;
- my $ok;
- given($twenty_five) {
- when ($_ ge "40") { $ok = "forty" }
- when ($_ ge "30") { $ok = "thirty" }
- when ($_ ge "20") { $ok = "twenty" }
- when ($_ ge "10") { $ok = "ten" }
- default { $ok = "default" }
- }
- is($ok, "twenty", $test);
-}
-
# Optimized-away comparisons
{
my $ok;
@@ -698,62 +672,6 @@ my $f = tie my $v, "FetchCounter";
}
}
-{
- my $first = 1;
- no warnings 'experimental::lexical_topic';
- my $_;
- for (1, "two") {
- when ("two") {
- is($first, 0, "Implicitly lexical loop: second");
- eval {break};
- like($@, qr/^Can't "break" in a loop topicalizer/,
- q{Can't "break" in a loop topicalizer});
- }
- when (1) {
- is($first, 1, "Implicitly lexical loop: first");
- $first = 0;
- # Implicit break is okay
- }
- }
-}
-
-{
- my $first = 1;
- no warnings 'experimental::lexical_topic';
- my $_;
- for $_ (1, "two") {
- when ("two") {
- is($first, 0, "Implicitly lexical, explicit \$_: second");
- eval {break};
- like($@, qr/^Can't "break" in a loop topicalizer/,
- q{Can't "break" in a loop topicalizer});
- }
- when (1) {
- is($first, 1, "Implicitly lexical, explicit \$_: first");
- $first = 0;
- # Implicit break is okay
- }
- }
-}
-
-{
- my $first = 1;
- no warnings 'experimental::lexical_topic';
- for my $_ (1, "two") {
- when ("two") {
- is($first, 0, "Lexical loop: second");
- eval {break};
- like($@, qr/^Can't "break" in a loop topicalizer/,
- q{Can't "break" in a loop topicalizer});
- }
- when (1) {
- is($first, 1, "Lexical loop: first");
- $first = 0;
- # Implicit break is okay
- }
- }
-}
-
# Code references
{
@@ -1371,15 +1289,6 @@ unreified_check(undef,"");
# must ensure $_ is initialised and cleared at start/end of given block
{
- sub f1 {
- no warnings 'experimental::lexical_topic';
- my $_;
- given(3) {
- return sub { $_ } # close over lexical $_
- }
- }
- is(f1()->(), 3, 'closed over $_');
-
package RT94682;
my $d = 0;
@@ -1387,7 +1296,7 @@ unreified_check(undef,"");
sub f2 {
no warnings 'experimental::lexical_topic';
- my $_ = 5;
+ local $_ = 5;
given(bless [7]) {
::is($_->[0], 7, "is [7]");
}
diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index e221ececc0..629f2b286e 100644
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -1659,8 +1659,8 @@ sub run_tests {
{
# Test for keys in %+ and %-
my $message = 'Test keys in %+ and %-';
- no warnings 'uninitialized', 'deprecated', 'experimental::lexical_topic';
- my $_ = "abcdef";
+ no warnings 'uninitialized';
+ local $_ = "abcdef";
/(?<foo>a)|(?<foo>b)/;
is((join ",", sort keys %+), "foo", $message);
is((join ",", sort keys %-), "foo", $message);
@@ -1681,7 +1681,7 @@ sub run_tests {
{
# length() on captures, the numbered ones end up in Perl_magic_len
no warnings 'deprecated', 'experimental::lexical_topic';
- my $_ = "aoeu " . uni_to_native("\xe6") . "var ook";
+ local $_ = "aoeu " . uni_to_native("\xe6") . "var ook";
/^ \w+ \s (?<eek>\S+)/x;
is(length $`, 0, q[length $`]);
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index f35e72c35f..05404c71f3 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -856,8 +856,7 @@ sub run_tests {
{
my $message = '$REGMARK in replacement; Bug 49190';
our $REGMARK;
- no warnings 'experimental::lexical_topic';
- my $_ = "A";
+ local $_ = "A";
ok(s/(*:B)A/$REGMARK/, $message);
is($_, "B", $message);
$_ = "CCCCBAA";
diff --git a/t/re/qr.t b/t/re/qr.t
index 811f5c577d..f2082cd4f1 100644
--- a/t/re/qr.t
+++ b/t/re/qr.t
@@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 5;
+plan tests => 4;
my $rx = qr//;
@@ -33,26 +33,6 @@ is(ref $rx, "Regexp", "qr// blessed into 'Regexp' by default");
is $output, "5\n1: 5\n2: 5\n", '$a_match_var =~ /$qr/';
}
-no warnings 'experimental::lexical_topic';
-for my $_($'){
- my $output = '';
- my $rx = qr/o/;
- my $a = "ooaoaoao";
-
- my $foo = 0;
- $foo += () = ($a =~ /$rx/g);
- $output .= "$foo\n"; # correct
-
- $foo = 0;
- for ($foo += ($a =~ /o/); $' && /o/ && ($foo++) ; ) { ; }
- $output .= "1: $foo\n"; # No error
-
- $foo = 0;
- for ($foo += ($a =~ /$rx/); $' && /$rx/ && ($foo++) ; ) { ; }
- $output .= "2: $foo\n"; # initialization warning, incorrect results
-
- is $output, "5\n1: 5\n2: 5\n", '/$qr/ with my $_ aliased to a match var';
-}
for($'){
my $output = '';
my $rx = qr/o/;