Disable lexical $_
authorFather Chrysostomos <sprout@cpan.org>
Wed, 19 Aug 2015 20:10:16 +0000 (13:10 -0700)
committerRicardo Signes <rjbs@cpan.org>
Tue, 29 Sep 2015 14:49:19 +0000 (10:49 -0400)
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/.

20 files changed:
cpan/Devel-PPPort/t/misc.t
cpan/experimental/t/basic.t
ext/XS-APItest/t/newDEFSVOP.t
ext/XS-APItest/t/underscore_length.t
op.c
t/comp/uproto.t
t/lib/warnings/9uninit
t/lib/warnings/op
t/op/coreamp.t
t/op/exec.t
t/op/mkdir.t
t/op/mydef.t
t/op/override.t
t/op/reverse.t
t/op/signatures.t
t/op/state.t
t/op/switch.t
t/re/pat_advanced.t
t/re/pat_rt_report.t
t/re/qr.t

index 275fa98..5f7f7b6 100644 (file)
@@ -57,7 +57,7 @@ $_ = "Fred";
 ok(&Devel::PPPort::DEFSV(), "Fred");
 ok(&Devel::PPPort::UNDERBAR(), "Fred");
 
-if ($] >= 5.009002) {
+if ($] >= 5.009002 && $] < 5.023) {
   eval q{
     no warnings "deprecated";
     no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
index ee03a02..be27df6 100644 (file)
@@ -5,12 +5,14 @@ use Test::More 0.89;
 local $SIG{__WARN__} = sub { fail("Got unexpected warning"); diag($_[0]) };
 
 if ($] >= 5.010000) {
-       is (eval <<'END', 1, 'lexical topic compiles') or diag $@;
-       use experimental 'lexical_topic';
-       my $_ = 1;
-       is($_, 1, '$_ is 1');
-       1;
+       if ($] < 5.023) {
+               is (eval <<'END', 1, 'lexical topic compiles') or diag $@;
+               use experimental 'lexical_topic';
+               my $_ = 1;
+               is($_, 1, '$_ is 1');
+               1;
 END
+       }
 }
 else {
        fail("No experimental features available on perl $]");
index 1ba6ee6..42d45b2 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 16;
+use Test::More tests => 7;
 
 use XS::APItest qw(DEFSV);
 
@@ -18,23 +18,3 @@ is $_, "foo";
 $_ = "bar";
 is DEFSV, "bar";
 is $_, "bar";
-
-{
-    no warnings 'experimental::lexical_topic';
-    my $_;
-
-    is $_, undef;
-    is DEFSV, undef;
-    is \DEFSV, \$_;
-
-    DEFSV = "lex-foo";
-    is DEFSV, "lex-foo";
-    is $_, "lex-foo";
-
-    $_ = "lex-bar";
-    is DEFSV, "lex-bar";
-    is $_, "lex-bar";
-}
-
-is DEFSV, "bar";
-is $_, "bar";
index 545b2a3..467236f 100644 (file)
@@ -1,7 +1,7 @@
 use warnings; no warnings 'experimental::lexical_topic';
 use strict;
 
-use Test::More tests => 4;
+use Test::More tests => 2;
 
 use XS::APItest qw(underscore_length);
 
@@ -11,10 +11,4 @@ is underscore_length(), 3;
 $_ = "snowman \x{2603}";
 is underscore_length(), 9;
 
-my $_ = "xyzzy";
-is underscore_length(), 5;
-
-$_ = "pile of poo \x{1f4a9}";
-is underscore_length(), 13;
-
 1;
diff --git a/op.c b/op.c
index 745cb5f..5d396b8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -594,7 +594,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
        !(is_our ||
          isALPHA(name[1]) ||
          ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||
-         (name[1] == '_' && (*name == '$' || len > 2))))
+         (name[1] == '_' && len > 2)))
     {
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])
index f81e314..9db6d54 100644 (file)
@@ -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' );
-}
index d26d6ca..ef9b4f6 100644 (file)
@@ -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);
index d2f8e57..b253741 100644 (file)
@@ -1,8 +1,5 @@
   op.c         AOK
 
-     Use of my $_ is experimental
-       my $_ ;
-
      Found = in conditional, should be ==
        1 if $a = 1 ;
 
     
 __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
index b6c9487..7a99155 100644 (file)
@@ -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 $_';
 
index 6ec3646..325ccb2 100644 (file)
@@ -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' );
 }
 
index 35e4773..d37acc6 100644 (file)
@@ -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);
-}
index b993f1b..11b55dd 100644 (file)
@@ -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();
index ff43571..e660311 100644 (file)
@@ -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);
index 059ece2..74e6295 100644 (file)
@@ -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' );
-    }
-}
index e1c3140..217efa3 100644 (file)
@@ -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/;
 
index 81e5486..ed68b51 100644 (file)
@@ -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';
@@ -203,22 +203,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.
 #
index 204a57a..d8cae7d 100644 (file)
@@ -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]");
        }
index e221ece..629f2b2 100644 (file)
@@ -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 $`]);
index f35e72c..05404c7 100644 (file)
@@ -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";
index 811f5c5..f2082cd 100644 (file)
--- 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/;