diff options
author | Father Chrysostomos <sprout@cpan.org> | 2015-08-19 13:10:16 -0700 |
---|---|---|
committer | Ricardo Signes <rjbs@cpan.org> | 2015-09-29 10:49:19 -0400 |
commit | 7fba29668402ec06ad00dfafda69913bcbb2c1df (patch) | |
tree | 70b3e0d3f06e47f23571ce6f95c09991ee83b39b /t | |
parent | 96f902ff649ca0f75966f5282611d16ecf5f907e (diff) | |
download | perl-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.t | 31 | ||||
-rw-r--r-- | t/lib/warnings/9uninit | 82 | ||||
-rw-r--r-- | t/lib/warnings/op | 14 | ||||
-rw-r--r-- | t/op/coreamp.t | 33 | ||||
-rw-r--r-- | t/op/exec.t | 3 | ||||
-rw-r--r-- | t/op/mkdir.t | 12 | ||||
-rw-r--r-- | t/op/mydef.t | 208 | ||||
-rw-r--r-- | t/op/override.t | 13 | ||||
-rw-r--r-- | t/op/reverse.t | 15 | ||||
-rw-r--r-- | t/op/signatures.t | 18 | ||||
-rw-r--r-- | t/op/state.t | 18 | ||||
-rw-r--r-- | t/op/switch.t | 95 | ||||
-rw-r--r-- | t/re/pat_advanced.t | 6 | ||||
-rw-r--r-- | t/re/pat_rt_report.t | 3 | ||||
-rw-r--r-- | t/re/qr.t | 22 |
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"; @@ -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/; |