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