regmatch(): do nextchr=*locinput at top of loop

[perl5.git] / t / op / local.t

diff --git a/t/op/local.t b/t/op/local.t
index fababb7..3b9b021 100644 (file)
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -618,8 +618,6 @@ while (/(o.+?),/gc) {
        "Chop"        => sub { chop },                          0,
        "Filetest"    => sub { -x },                            0,
        "Assignment"  => sub { $_ = "Bad" },                    0,
-       # XXX whether next one should fail is debatable
-       "Local \$_"   => sub { local $_  = 'ok?'; print },      0,
        "for local"   => sub { for("#ok?\n"){ print } },        1,
     );
     while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) {
@@ -644,26 +642,28 @@ while (/(o.+?),/gc) {
 eval { local $1 = 1 };
 like($@, qr/Modification of a read-only value attempted/);
 
+# local($_) always strips all magic
 eval { for ($1) { local $_ = 1 } };
-like($@, qr/Modification of a read-only value attempted/);
-
-# make sure $1 is still read-only
-eval { for ($1) { local $_ = 1 } };
-like($@, qr/Modification of a read-only value attempted/);
-
-# The s/// adds 'g' magic to $_, but it should remain non-readonly
-eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
 is($@, "");
 
-# RT #4342 Special local() behavior for $[
 {
-    no warnings 'deprecated';
-    local $[ = 1;
-    ok(1 == $[, 'lexcical scope of local $[');
-    f();
+    my $STORE = my $FETCH = 0;
+    package TieHash;
+    sub TIEHASH { bless $_[1], $_[0] }
+    sub FETCH   { ++$FETCH; 42 }
+    sub STORE   { ++$STORE }
+
+    package main;
+    tie my %hash, "TieHash", {};
+
+    eval { for ($hash{key}) {local $_ = 2} };
+    is($STORE, 0);
+    is($FETCH, 0);
 }
 
-sub f { ok(0 == $[); }
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
+is($@, "");
 
 # sub localisation
 {
@@ -781,38 +781,47 @@ like( runperl(stderr => 1,
                       'index(q(a), foo);' .
                       'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]");
 
-# localising a tied scalar should give you an untied var
-{
-    package TS;
-    sub TIESCALAR { bless \my $self, shift }
-
-    my $s;
-    sub FETCH { $s .= ":F=${$_[0]}"; ${$_[0]} }
-    sub STORE { $s .= ":S($_[1])"; ${$_[0]} = $_[1]; }
-
-    package main;
-    tie $ts, 'TS';
-    $ts = 1;
-    {
-       $s .= ':L1';
-       local $ts;
-       $s .= ':L2';
-       is($ts, undef, 'local tied scalar initially undef');
-       $ts = 2;
-       is($ts, 2, 'local tied scalar now has a value');
-       $s .= ':E';
-    }
-    is($ts, 1, 'restored tied scalar has correct value');
-    $ts = 3;
-    is($s, ':S(1):L1:F=1:L2:E:F=1:S(3)',
-               "local tied scalar shouldn't call methods");
-}
-
-# Keep this test last, as it can SEGV
+# related to perl #112966
+# Magic should not cause elements not to be deleted after scope unwinding
+# when they did not exist before local()
+() = \$#squinch; # $#foo in lvalue context makes array magical
+{
+    local $squinch[0];
+    local @squinch[1..2];
+    package Flibbert;
+    m??; # makes stash magical
+    local $Flibbert::{foo};
+    local @Flibbert::{<bar baz>};
+}
+ok !exists $Flibbert::{foo},
+  'local helem on magic hash does not leave elems on scope exit';
+ok !exists $Flibbert::{bar},
+  'local hslice on magic hash does not leave elems on scope exit';
+ok !exists $squinch[0],
+  'local aelem on magic hash does not leave elems on scope exit';
+ok !exists $squinch[1],
+  'local aslice on magic hash does not leave elems on scope exit';
+
+# Keep these tests last, as they can SEGV
 {
     local *@;
     pass("Localised *@");
     eval {1};
     pass("Can eval with *@ localised");
+
+    local @{"nugguton"};
+    local %{"netgonch"};
+    delete $::{$_} for 'nugguton','netgonch';
 }
+pass ('localised arrays and hashes do not crash if glob is deleted');
 
+# [perl #112966] Rmagic can cause delete local to crash
+package Grompits {
+local $SIG{__WARN__};
+    delete local $ISA[0];
+    delete local @ISA[1..10];
+    m??; # makes stash magical
+    delete local $Grompits::{foo};
+    delete local @Grompits::{<foo bar>};
+}
+pass 'rmagic does not cause delete local to crash on nonexistent elems';