Perl_ck_refassign: support refassigning into a state variable

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

diff --git a/t/op/lvref.t b/t/op/lvref.t
index d55ccd2..f589468 100644 (file)
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -1,35 +1,36 @@
+#!perl
 BEGIN {
     chdir 't';
     require './test.pl';
     set_up_inc("../lib");
 }
 
-plan 153;
+plan 170;
 
 eval '\$x = \$y';
-like $@, qr/^Experimental lvalue references not enabled/,
+like $@, qr/^Experimental aliasing via reference not enabled/,
     'error when feature is disabled';
 eval '\($x) = \$y';
-like $@, qr/^Experimental lvalue references not enabled/,
+like $@, qr/^Experimental aliasing via reference not enabled/,
     'error when feature is disabled (aassign)';
 
-use feature 'lvalue_refs', 'state';
+use feature 'refaliasing', 'state';
 
 {
     my($w,$c);
     local $SIG{__WARN__} = sub { $c++; $w = shift };
     eval '\$x = \$y';
     is $c, 1, 'one warning from lv ref assignment';
-    like $w, qr/^Lvalue references are experimental/,
+    like $w, qr/^Aliasing via reference is experimental/,
         'experimental warning';
     undef $c;
     eval '\($x) = \$y';
     is $c, 1, 'one warning from lv ref list assignment';
-    like $w, qr/^Lvalue references are experimental/,
+    like $w, qr/^Aliasing via reference is experimental/,
         'experimental warning';
 }
 
-no warnings 'experimental::lvalue_refs';
+no warnings 'experimental::refaliasing';
 
 # Scalars
 
@@ -75,11 +76,13 @@ for (1,2) {
   \my($y) = \3,
   \state $a = \3,
   \state($b) = \3 if $_ == 1;
+  \state $c = \$_;
   if ($_ == 2) {
     is $x, undef, '\my $x = ... clears $x on scope exit';
     is $y, undef, '\my($x) = ... clears $x on scope exit';
     is $a, 3, '\state $x = ... does not clear $x on scope exit';
     is $b, 3, '\state($x) = ... does not clear $x on scope exit';
+    is $c, 1, '\state $x = ... can be used with refaliasing';
   }
 }
 
@@ -209,11 +212,13 @@ for (1,2) {
   \my(@y) = \3,
   \state @a = [1..3],
   \state(@b) = \3 if $_ == 1;
+  \state @c = [$_];
   if ($_ == 2) {
     is @x, 0, '\my @x = ... clears @x on scope exit';
     is @y, 0, '\my(@x) = ... clears @x on scope exit';
     is "@a", "1 2 3", '\state @x = ... does not clear @x on scope exit';
     is "@b", 3, '\state(@x) = ... does not clear @x on scope exit';
+    is $c[0], 1, '\state @x = ... can be used with refaliasing';
   }
 }
 
@@ -253,9 +258,11 @@ package HashTest {
 for (1,2) {
   \state %y = {1,2},
   \my %x = {1,2} if $_ == 1;
+  \state %c = {X => $_};
   if ($_ == 2) {
     is %x, 0, '\my %x = ... clears %x on scope exit';
     is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit';
+    is $c{X}, 1, '\state %x = ... can be used with refaliasing';
   }
 }
 
@@ -291,6 +298,18 @@ package CodeTest {
   my sub bs;
   \(&cs) = expect_list_cx;
   is \&cs, \&ThatSub, '\(&statesub)';
+
+  package main {
+    # this is only a problem in main:: due to 1e2cfe157ca
+    sub sx { "x" }
+    sub sy { "y" }
+    is sx(), "x", "check original";
+    my $temp = \&sx;
+    \&sx = \&sy;
+    is sx(), "y", "aliased";
+    \&sx = $temp;
+    is sx(), "x", "and restored";
+  }
 }
 
 # Mixed List Assignments
@@ -488,6 +507,10 @@ eval '$foo ? \%{"42"} : \%43 = 42';
 like $@,
     qr/^Can't modify reference to hash dereference in scalar assignment a/,
    "Can't modify ref to whatever in scalar assignment via cond expr";
+eval '\$0=~y///=0';
+like $@,
+    qr#^Can't modify transliteration \(tr///\) in scalar assignment a#,
+   "Can't modify transliteration (tr///) in scalar assignment";
 
 # Miscellaneous
 
@@ -521,11 +544,10 @@ like $@,
   is s(3), 1, 'padstale alias should not reset state'
 }
 
-SKIP: {
-    skip_without_dynamic_extension('List/Util');
-    require Scalar::Util;
+{
     my $a;
-    Scalar::Util::weaken($r = \$a);
+    no warnings 'experimental::builtin';
+    builtin::weaken($r = \$a);
     \$a = $r;
     pass 'no crash when assigning \$lex = $weakref_to_lex'
 }
@@ -587,3 +609,51 @@ SKIP: {
     \(@a) = \($x,$y);
     goto do_test3;
 }
+
+# Used to fail an assertion [perl #123821]
+eval '\(&$0)=0';
+pass("RT #123821");
+
+# Used to fail an assertion [perl #128252]
+{
+    no feature 'refaliasing';
+    use warnings;
+    eval q{sub{\@0[0]=0};};
+    pass("RT #128252");
+}
+
+# RT #133538 slices were inadvertently always localising
+
+{
+    use feature 'refaliasing';
+    no warnings 'experimental';
+
+    my @src = (100,200,300);
+
+    my @a = (1,2,3);
+    my %h = qw(one 10 two 20 three 30);
+
+    {
+        use feature 'declared_refs';
+        local \(@a[0,1,2]) = \(@src);
+        local \(@h{qw(one two three)}) = \(@src);
+        $src[0]++;
+        is("@a", "101 200 300", "rt #133538 \@a aliased");
+        is("$h{one} $h{two} $h{three}", "101 200 300", "rt #133538 %h aliased");
+    }
+    is("@a", "1 2 3", "rt #133538 \@a restored");
+    is("$h{one} $h{two} $h{three}", "10 20 30", "rt #133538 %h restored");
+
+    {
+        \(@a[0,1,2]) = \(@src);
+        \(@h{qw(one two three)}) = \(@src);
+        $src[0]++;
+        is("@a", "102 200 300", "rt #133538 \@a aliased try 2");
+        is("$h{one} $h{two} $h{three}", "102 200 300",
+                "rt #133538 %h aliased try 2");
+    }
+    $src[2]++;
+    is("@a", "102 200 301", "rt #133538 \@a still aliased");
+    is("$h{one} $h{two} $h{three}", "102 200 301", "rt #133538 %h still aliased");
+
+}