Skip to content

Add regression tests for GH-23816 #23820

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

Add regression tests for GH-23816 #23820

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
9fdc724
Use indented heredoc to make loop structure more visible
jkeenan Oct 6, 2025
eb955bc
Regression tests for GH-23816
jkeenan Oct 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
163 changes: 86 additions & 77 deletions t/op/decl-refs.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ BEGIN {
set_up_inc('../lib');
}

plan 402;
plan 404;

for my $decl (qw< my CORE::state our local >) {
for my $funny (qw< $ @ % >) {
Expand Down Expand Up @@ -39,84 +39,93 @@ 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';
*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';
return;
};
SKIP : {
unless ('MY' eq 'local') {
skip_if_miniperl "No attributes on miniperl", 2;
eval 'MY \~h : risible' or die $@ unless 'MY' eq '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';
*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';
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 \~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';
*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';
return;
};
SKIP : {
unless ('MY' eq 'local') {
skip_if_miniperl "No attributes on miniperl", 2;
eval 'MY (\~h) : bumpy' or die $@;
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';
*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';
return;
};
SKIP : {
unless ('MY' eq 'local') {
skip_if_miniperl "No attributes on miniperl", 2;
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 $@;
}}
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 $@;
} # END 'for $sigl' loop
} # END 'for $decl' loop


use feature 'refaliasing'; no warnings "experimental::refaliasing";

my \@bar = [];
my $ref = my \@bar = [];
ok defined $ref, 'GH-23816: declared_ref is defined';
is ref($ref), 'ARRAY', 'GH-23816: identified array ref';

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 $@;
}}
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 $@;
} # END 'for $sigl' loop
} # END 'for $decl' loop
Loading