1BEGIN {
2    chdir 't';
3    require './test.pl';
4    set_up_inc('../lib');
5}
6
7plan 402;
8
9for my $decl (qw< my CORE::state our local >) {
10    for my $funny (qw< $ @ % >) {
11        # Test three syntaxes with each declarator/funny char combination:
12        #     my \$foo    my(\$foo)    my\($foo)    for my \$foo
13
14        for my $code("$decl \\${funny}x", "$decl\(\\${funny}x\)",
15                     "$decl\\\(${funny}x\)",
16                     "for $decl \\${funny}x (\\${funny}y) {}") {
17          SKIP: {
18            skip "for local is illegal", 3 if $code =~ /^for local/;
19            eval $code;
20            like
21                $@,
22                qr/^The experimental declared_refs feature is not enabled/,
23               "$code error when feature is disabled";
24
25            use feature 'declared_refs';
26
27            my($w,$c);
28            local $SIG{__WARN__} = sub { $c++; $w = shift };
29            eval $code;
30            is $c, 1, "one warning from $code";
31            like $w, qr/^Declaring references is experimental at /,
32                "experimental warning for $code";
33          }
34        }
35    }
36}
37
38use feature 'declared_refs', 'state';
39no warnings 'experimental::declared_refs';
40
41for $decl ('my', 'state', 'our', 'local') {
42for $sigl ('$', '@', '%') {
43    # The weird code that follows uses ~ as a sigil placeholder and MY
44    # as a declarator placeholder.
45    my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'END';
46    my $ret = MY \~a;
47    is $ret, \~a, 'MY \$a returns ref to $a';
48    isnt $ret, \~::a, 'MY \$a ret val is not pkg var';
49    my @ret = MY \(~b, ~c);
50    is "@ret", \~b." ".\~c, 'MY \(~b, ~c) returns correct refs';
51    isnt $ret[0], \~::b, 'first retval of MY \(~b, ~c) is not pkg var';
52    isnt $ret[1], \~::c, '2nd retval of MY \(~b, ~c) is not pkg var';
53    @ret = MY (\(~d, ~e));
54    is "@ret", \~d." ".\~e, 'MY (\(~d, ~e)) returns correct refs';
55    isnt $ret[0], \~::d, 'first retval of MY (\(~d, ~e)) is not pkg var';
56    isnt $ret[1], \~::e, '2nd retval of MY (\(~d, ~e)) is not pkg var';
57    @ret = \MY (\~f, ~g);
58    is ${$ret[0]}, \~f, 'first retval of MY (\~f, ~g) is \~f';
59    isnt ${$ret[0]}, \~::f, 'first retval of MY (\~f, ~g) is not \~::f';
60    is $ret[1], \~g, '2nd retval of MY (\~f, ~g) is ~g';
61    isnt $ret[1], \~::g, '2nd retval of MY (\~f, ~g) is not ~::g';
62    *MODIFY_SCALAR_ATTRIBUTES = sub {
63        is @_, 3, 'MY \~h : risible  calls handler with right no. of args';
64        is $_[2], 'risible', 'correct attr passed by MY \~h : risible';
65        return;
66    };
67    SKIP : {
68        unless ('MY' eq 'local') {
69            skip_if_miniperl "No attributes on miniperl", 2;
70            eval 'MY \~h : risible' or die $@ unless 'MY' eq 'local';
71        }
72    }
73    eval 'MY \~a ** 1';
74    like $@,
75        qr/^Can't (?:declare|modify) exponentiation \(\*\*\) in "?MY"? at/,
76       'comp error for MY \~a ** 1';
77    $ret = MY \\~i;
78    is $$ret, \~i, 'retval of MY \\~i is ref to ref to ~i';
79    $ret = MY \\~i;
80    isnt $$ret, \~::i, 'retval of MY \\~i is ref to ref to ~::i';
81    $ret = MY (\\~i);
82    is $$ret, \~i, 'retval of MY (\\~i) is ref to ref to ~i';
83    $ret = MY (\\~i);
84    isnt $$ret, \~::i, 'retval of MY (\\~i) is ref to ref to ~::i';
85    *MODIFY_SCALAR_ATTRIBUTES = sub {
86        is @_, 3, 'MY (\~h) : bumpy  calls handler with right no. of args';
87        is $_[2], 'bumpy', 'correct attr passed by MY (\~h) : bumpy';
88        return;
89    };
90    SKIP : {
91        unless ('MY' eq 'local') {
92            skip_if_miniperl "No attributes on miniperl", 2;
93            eval 'MY (\~h) : bumpy' or die $@;
94        }
95    }
96    1;
97END
98    $code =~ s/MY/$decl/g;
99    $code =~ s/~/$sigl/g;
100    $code =~ s/MODIFY_\KSCALAR/$sigl eq '@' ? "ARRAY" : "HASH"/eggnog
101        if $sigl ne '$';
102    if ($decl =~ /^(?:our|local)\z/) {
103        $code =~ s/is ?no?t/is/g; # tests for package vars
104    }
105    eval $code or die $@;
106}}
107
108use feature 'refaliasing'; no warnings "experimental::refaliasing";
109for $decl ('my', 'state', 'our') {
110for $sigl ('$', '@', '%') {
111    my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'ENE';
112    for MY \~x (\~::y) {
113        is \~x, \~::y, '\~x aliased by for MY \~x';
114        isnt \~x, \~::x, '\~x is not equivalent to \~::x';
115    }
116    1;
117ENE
118    $code =~ s/MY/$decl/g;
119    $code =~ s/~/$sigl/g;
120    $code =~ s/is ?no?t/is/g if $decl eq 'our';
121    eval $code or die $@;
122}}
123