detect sub attributes following a signature

[perl5.git] / t / op / decl-refs.t

diff --git a/t/op/decl-refs.t b/t/op/decl-refs.t
index 2c11daa..80e6b7f 100644 (file)
--- a/t/op/decl-refs.t
+++ b/t/op/decl-refs.t
@@ -4,15 +4,18 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan 188;
+plan 402;
 
 for my $decl (qw< my CORE::state our local >) {
     for my $funny (qw< $ @ % >) {
         # Test three syntaxes with each declarator/funny char combination:
-        #     my \$foo    my(\$foo)    my\($foo)
+        #     my \$foo    my(\$foo)    my\($foo)    for my \$foo
 
         for my $code("$decl \\${funny}x", "$decl\(\\${funny}x\)",
-                     "$decl\\\(${funny}x\)") {
+                     "$decl\\\(${funny}x\)",
+                     "for $decl \\${funny}x (\\${funny}y) {}") {
+          SKIP: {
+            skip "for local is illegal", 3 if $code =~ /^for local/;
             eval $code;
             like
                 $@,
@@ -27,6 +30,7 @@ for my $decl (qw< my CORE::state our local >) {
             is $c, 1, "one warning from $code";
             like $w, qr/^Declaring references is experimental at /,
                 "experimental warning for $code";
+          }
         }
     }
 }
@@ -35,62 +39,84 @@ use feature 'declared_refs', 'state';
 no warnings 'experimental::declared_refs';
 
 for $decl ('my', 'state', 'our', 'local') {
+for $sigl ('$', '@', '%') {
+    # The weird code that follows uses ~ as a sigil placeholder and MY
+    # as a declarator placeholder.
     my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'END';
-    my $ret = MY \$a;
-    is $ret, \$a, 'MY \$a returns ref to $a';
-    isnt $ret, \$::a, 'MY \$a ret val is not pkg var';
-    my @ret = MY \($b, $c);
-    is "@ret", \$b." ".\$c, 'MY \($b, $c) returns correct refs';
-    isnt $ret[0], \$::b, 'first retval of MY \($b, $c) is not pkg var';
-    isnt $ret[1], \$::c, '2nd retval of MY \($b, $c) is not pkg var';
-    @ret = MY (\($d, $e));
-    is "@ret", \$d." ".\$e, 'MY (\($d, $e)) returns correct refs';
-    isnt $ret[0], \$::d, 'first retval of MY (\($d, $e)) is not pkg var';
-    isnt $ret[1], \$::e, '2nd retval of MY (\($d, $e)) is not pkg var';
-    @ret = \MY (\$f, $g);
-    is ${$ret[0]}, \$f, 'first retval of MY (\$f, $g) is \$f';
-    isnt ${$ret[0]}, \$::f, 'first retval of MY (\$f, $g) is not \$::f';
-    is $ret[1], \$g, '2nd retval of MY (\$f, $g) is $g';
-    isnt $ret[1], \$::g, '2nd retval of MY (\$f, $g) is not $::g';
+    my $ret = MY \~a;
+    is $ret, \~a, 'MY \$a returns ref to $a';
+    isnt $ret, \~::a, 'MY \$a ret val is not pkg var';
+    my @ret = MY \(~b, ~c);
+    is "@ret", \~b." ".\~c, 'MY \(~b, ~c) returns correct refs';
+    isnt $ret[0], \~::b, 'first retval of MY \(~b, ~c) is not pkg var';
+    isnt $ret[1], \~::c, '2nd retval of MY \(~b, ~c) is not pkg var';
+    @ret = MY (\(~d, ~e));
+    is "@ret", \~d." ".\~e, 'MY (\(~d, ~e)) returns correct refs';
+    isnt $ret[0], \~::d, 'first retval of MY (\(~d, ~e)) is not pkg var';
+    isnt $ret[1], \~::e, '2nd retval of MY (\(~d, ~e)) is not pkg var';
+    @ret = \MY (\~f, ~g);
+    is ${$ret[0]}, \~f, 'first retval of MY (\~f, ~g) is \~f';
+    isnt ${$ret[0]}, \~::f, 'first retval of MY (\~f, ~g) is not \~::f';
+    is $ret[1], \~g, '2nd retval of MY (\~f, ~g) is ~g';
+    isnt $ret[1], \~::g, '2nd retval of MY (\~f, ~g) is not ~::g';
     *MODIFY_SCALAR_ATTRIBUTES = sub {
-        is @_, 3, 'MY \$h : risible  calls handler with right no. of args';
-        is $_[2], 'risible', 'correct attr passed by MY \$h : risible';
+        is @_, 3, 'MY \~h : risible  calls handler with right no. of args';
+        is $_[2], 'risible', 'correct attr passed by MY \~h : risible';
         return;
     };
     SKIP : {
         unless ('MY' eq 'local') {
             skip_if_miniperl "No attributes on miniperl", 2;
-            eval 'MY \$h : risible' or die $@ unless 'MY' eq 'local';
+            eval 'MY \~h : risible' or die $@ unless 'MY' eq 'local';
         }
     }
-    eval 'MY \$a ** 1';
+    eval 'MY \~a ** 1';
     like $@,
         qr/^Can't (?:declare|modify) exponentiation \(\*\*\) in "?MY"? at/,
-       'comp error for MY \$a ** 1';
-    $ret = MY \\$i;
-    is $$ret, \$i, 'retval of MY \\$i is ref to ref to $i';
-    $ret = MY \\$i;
-    isnt $$ret, \$::i, 'retval of MY \\$i is ref to ref to $::i';
-    $ret = MY (\\$i);
-    is $$ret, \$i, 'retval of MY (\\$i) is ref to ref to $i';
-    $ret = MY (\\$i);
-    isnt $$ret, \$::i, 'retval of MY (\\$i) is ref to ref to $::i';
+       'comp error for MY \~a ** 1';
+    $ret = MY \\~i;
+    is $$ret, \~i, 'retval of MY \\~i is ref to ref to ~i';
+    $ret = MY \\~i;
+    isnt $$ret, \~::i, 'retval of MY \\~i is ref to ref to ~::i';
+    $ret = MY (\\~i);
+    is $$ret, \~i, 'retval of MY (\\~i) is ref to ref to ~i';
+    $ret = MY (\\~i);
+    isnt $$ret, \~::i, 'retval of MY (\\~i) is ref to ref to ~::i';
     *MODIFY_SCALAR_ATTRIBUTES = sub {
-        is @_, 3, 'MY (\$h) : bumpy  calls handler with right no. of args';
-        is $_[2], 'bumpy', 'correct attr passed by MY (\$h) : bumpy';
+        is @_, 3, 'MY (\~h) : bumpy  calls handler with right no. of args';
+        is $_[2], 'bumpy', 'correct attr passed by MY (\~h) : bumpy';
         return;
     };
     SKIP : {
         unless ('MY' eq 'local') {
             skip_if_miniperl "No attributes on miniperl", 2;
-            eval 'MY (\$h) : bumpy' or die $@;
+            eval 'MY (\~h) : bumpy' or die $@;
         }
     }
     1;
 END
     $code =~ s/MY/$decl/g;
+    $code =~ s/~/$sigl/g;
+    $code =~ s/MODIFY_\KSCALAR/$sigl eq '@' ? "ARRAY" : "HASH"/eggnog
+        if $sigl ne '$';
     if ($decl =~ /^(?:our|local)\z/) {
         $code =~ s/is ?no?t/is/g; # tests for package vars
     }
     eval $code or die $@;
-}
+}}
+
+use feature 'refaliasing'; no warnings "experimental::refaliasing";
+for $decl ('my', 'state', 'our') {
+for $sigl ('$', '@', '%') {
+    my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'ENE';
+    for MY \~x (\~::y) {
+        is \~x, \~::y, '\~x aliased by for MY \~x';
+        isnt \~x, \~::x, '\~x is not equivalent to \~::x';
+    }
+    1;
+ENE
+    $code =~ s/MY/$decl/g;
+    $code =~ s/~/$sigl/g;
+    $code =~ s/is ?no?t/is/g if $decl eq 'our';
+    eval $code or die $@;
+}}