From 9fdc7248b02493a918c04daa29d13d6421e2596b Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 6 Oct 2025 18:46:05 -0400 Subject: [PATCH 1/2] Use indented heredoc to make loop structure more visible This test file consists of sets of nested 'for' loops. The closing braces of the loops in two of those sets were on the same line, which made the code less legible. To uncuddle them, we eat our own dogfood and convert two heredocs to indented heredocs. --- t/op/decl-refs.t | 154 ++++++++++++++++++++++++----------------------- 1 file changed, 78 insertions(+), 76 deletions(-) diff --git a/t/op/decl-refs.t b/t/op/decl-refs.t index 80e6b7fbcaeb..dec91d515c89 100644 --- a/t/op/decl-refs.t +++ b/t/op/decl-refs.t @@ -39,84 +39,86 @@ 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"; 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 From eb955bc531fd54b9078c237b191e99db76201e56 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 6 Oct 2025 19:16:03 -0400 Subject: [PATCH 2/2] Regression tests for GH-23816 --- t/op/decl-refs.t | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/t/op/decl-refs.t b/t/op/decl-refs.t index dec91d515c89..5eb9e34fb22c 100644 --- a/t/op/decl-refs.t +++ b/t/op/decl-refs.t @@ -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< $ @ % >) { @@ -106,7 +106,14 @@ for $decl ('my', 'state', 'our', 'local') { } # 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';