make t/op/rand.t fail less often

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

diff --git a/t/op/local.t b/t/op/local.t
index fababb7..1f36a73 100644 (file)
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
     require './test.pl';
 }
-plan tests => 310;
+plan tests => 306;
 
 my $list_assignment_supported = 1;
 
@@ -644,12 +644,23 @@ 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/);
+is($@, "");
 
-# make sure $1 is still read-only
-eval { for ($1) { local $_ = 1 } };
-like($@, qr/Modification of a read-only value attempted/);
+{
+    my $STORE = 0;
+    package TieHash;
+    sub TIEHASH { bless $_[1], $_[0] }
+    sub FETCH   { 42 }
+    sub STORE   { ++$STORE }
+
+    package main;
+    tie my %hash, "TieHash", {};
+
+    eval { for ($hash{key}) {local $_ = 2} };
+    is($STORE, 0);
+}
 
 # The s/// adds 'g' magic to $_, but it should remain non-readonly
 eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
@@ -781,33 +792,6 @@ 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
 {
     local *@;