From 1fb44614617a2ed1f6142732ccb993e7aa3a4b85 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Fri, 29 Aug 2025 16:23:55 -0400 Subject: [PATCH] Separate 'goto' tests according to flavor tested Create t/op/goto-sub.t to hold tests for 'goto &NAME', as they will presumably be unaffected by deprecation/fatalization of certain other usages of 'goto'. In the course of working on this a few other small cleanups were made, e.g., disambiguation of various uses of $ok; small whitespace cleanup; more use of {} blocks to distinguish among clusters of tests. --- MANIFEST | 1 + t/op/goto-sub.t | 364 ++++++++++++++++++++++++++++++++++++++++++++++++ t/op/goto.t | 310 +---------------------------------------- 3 files changed, 372 insertions(+), 303 deletions(-) create mode 100644 t/op/goto-sub.t diff --git a/MANIFEST b/MANIFEST index 57a49af62e95..e2bd454e2e96 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6348,6 +6348,7 @@ t/op/getppid.t See if getppid works t/op/glob.t See if <*> works t/op/gmagic.t See if GMAGIC works t/op/goto.t See if goto works +t/op/goto-sub.t See if goto &NAME works t/op/goto_xs.t See if "goto &sub" works on XSUBs t/op/grent.t See if getgr*() functions work t/op/grep.t See if grep() and map() work diff --git a/t/op/goto-sub.t b/t/op/goto-sub.t new file mode 100644 index 000000000000..d32b18b48d47 --- /dev/null +++ b/t/op/goto-sub.t @@ -0,0 +1,364 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require "./test.pl"; + set_up_inc( qw(. ../lib) ); + require './charset_tools.pl'; +} + +use warnings; +use strict; +use Config; +plan tests => 40; + +# Excerpts from 'perldoc -f goto' as of perl-5.40.1 (Aug 2025) +# +# The "goto &NAME" form is quite different from the other forms of +# "goto". In fact, it isn't a goto in the normal sense at all, and +# doesn't have the stigma associated with other gotos. Instead, it +# exits the current subroutine (losing any changes set by "local") +# and immediately calls in its place the named subroutine using +# the current value of @_. This is used by "AUTOLOAD" subroutines +# that wish to load another subroutine and then pretend that the +# other subroutine had been called in the first place (except that +# any modifications to @_ in the current subroutine are propagated +# to the other subroutine.) After the "goto", not even "caller" +# will be able to tell that this routine was called first. +# +# NAME needn't be the name of a subroutine; it can be a scalar +# variable containing a code reference or a block that evaluates +# to a code reference. + +# but earlier, we see: +# +# The "goto EXPR" form expects to evaluate "EXPR" to a code +# reference or a label name. If it evaluates to a code reference, +# it will be handled like "goto &NAME", below. This is especially +# useful for implementing tail recursion via "goto __SUB__". +# +# The purpose this test file is to consolidate all tests formerly found in +# t/op/goto.t that exercise the "goto &NAME" functionality. These should be +# outside the scope of the current (5.42) deprecation of aspects of "goto +# LABEL" (GH #23618) now scheduled for 5.44. If we have done that +# successfully, then during the 5.43 dev cycle we shouldn't see any instances +# of this warning (or of its fatalization replacement). + +my $deprecated = 0; + +local $SIG{__WARN__} = sub { + if ($_[0] =~ m/jump into a construct.*?, and will become fatal in Perl 5\.42/) { + $deprecated++; + } + else { warn $_[0] } +}; + +our $foo; + +################### + +# bug #9990 - don't prematurely free the CV we're &going to. + +sub f1 { + my $x; + goto sub { $x=0; ok(1,"don't prematurely free CV\n") } +} +f1(); + +# bug #99850, which is similar - freeing the subroutine we are about to +# go(in)to during a FREETMPS call should not crash perl. + +package _99850 { + sub reftype{} + DESTROY { undef &reftype } + eval { sub { my $guard = bless []; goto &reftype }->() }; +} +like $@, qr/^Goto undefined subroutine &_99850::reftype at /, + 'goto &foo undefining &foo on sub cleanup'; + +# When croaking after discovering that the new CV you're about to goto is +# undef, make sure that the old CV isn't doubly freed. + +package Do_undef { + my $count; + + # creating a new closure here encourages any prematurely freed + # CV to be reallocated + sub DESTROY { undef &undef_sub; my $x = sub { $count } } + + sub f { + $count++; + my $guard = bless []; # trigger DESTROY during goto + *undef_sub = sub {}; + goto &undef_sub + } + + for (1..10) { + eval { f() }; + } + ::is($count, 10, "goto undef_sub safe"); +} + +# make sure that nothing nasty happens if the old CV is freed while +# goto'ing + +package Free_cv { + my $results; + sub f { + no warnings 'redefine'; + *f = sub {}; + goto &g; + } + sub g { $results = "(@_)" } + + f(1,2,3); + ::is($results, "(1 2 3)", "Free_cv"); +} + +# [perl #29708] - goto &foo could leave foo() at depth two with +# @_ == PL_sv_undef, causing a coredump + +my $r = runperl( + prog => + 'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)', + stderr => 1 + ); +is($r, "ok\n", 'avoid pad without an @_'); + +# see if a modified @_ propagates +{ + my $i; + package Foo; + sub DESTROY { my $s = shift; ::is($s->[0], $i, "destroy $i"); } + sub show { ::is(+@_, 5, "show $i",); } + sub start { push @_, 1, "foo", {}; goto &show; } + for (1..3) { $i = $_; start(bless([$_]), 'bar'); } +} + +sub auto { + goto &loadit; +} +my $ok; + +sub AUTOLOAD { $ok = 1 if "@_" eq "foo" } + +$ok = 0; +auto("foo"); +ok($ok, 'autoload'); + +# Test autoloading mechanism. + +sub two { + my ($pack, $file, $line) = caller; # Should indicate original call stats. + is("@_ $pack $file $line", "1 2 3 main $::FILE $::LINE", + 'autoloading mechanism.'); +} + +sub one { + eval <<'END'; + no warnings 'redefine'; + sub one { pass('sub one'); goto &two; fail('sub one tail'); } +END + goto &one; +} + +$::FILE = __FILE__; +$::LINE = __LINE__ + 1; +&one(1,2,3); + +# deep recursion with gotos eventually caused a stack reallocation +# which messed up buggy internals that didn't expect the stack to move + +sub recurse1 { + unshift @_, "x"; + no warnings 'recursion'; + goto &recurse2; +} +sub recurse2 { + my $x = shift; + $_[0] ? +1 + recurse1($_[0] - 1) : 0 +} + +{ +my $w = 0; + local $SIG{__WARN__} = sub { ++$w }; + is(recurse1(500), 500, 'recursive goto &foo'); + is $w, 0, 'no recursion warnings for "no warnings; goto &sub"'; + delete $SIG{__WARN__}; +} + +# [perl #32039] Chained goto &sub drops data too early. + +sub a32039 { @_=("foo"); goto &b32039; } +sub b32039 { goto &c32039; } +sub c32039 { is($_[0], 'foo', 'chained &goto') } +a32039(); + +################### + +# goto &foo not allowed in evals + +sub null { 1 }; +eval 'goto &null'; +like($@, qr/Can't goto subroutine from an eval-string/, 'eval string'); +eval { goto &null }; +like($@, qr/Can't goto subroutine from an eval-block/, 'eval block'); + +# goto &foo leaves @_ alone when called from a sub +sub returnarg { $_[0] }; +is sub { + local *_ = ["ick and queasy"]; + goto &returnarg; +}->("quick and easy"), "ick and queasy", + 'goto &foo with *_{ARRAY} replaced'; +my @__ = byte_utf8a_to_utf8n("\xc4\x80"); +sub { local *_ = \@__; goto &utf8::decode }->("no thinking aloud"); +is "@__", chr 256, 'goto &xsub with replaced *_{ARRAY}'; + +# And goto &foo should leave reified @_ alone +sub { *__ = \@_; goto &null } -> ("rough and tubbery"); +is ${*__}[0], 'rough and tubbery', 'goto &foo leaves reified @_ alone'; + +# goto &xsub when @_ has nonexistent elements +{ + no warnings "uninitialized"; + local @_ = (); + $#_++; + & {sub { goto &utf8::encode }}; + is @_, 1, 'num of elems in @_ after goto &xsub with nonexistent $_[0]'; + is $_[0], "", 'content of nonexistent $_[0] is modified by goto &xsub'; +} + +# goto &xsub when @_ itself does not exist +undef *_; +eval { & { sub { goto &utf8::encode } } }; +# The main thing we are testing is that it did not crash. But make sure +# *_{ARRAY} was untouched, too. +is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist'; + +# goto &perlsub when @_ itself does not exist [perl #119949] +# This was only crashing when the replaced sub call had an argument list. +# (I.e., &{ sub { goto ... } } did not crash.) +sub { + undef *_; + goto sub { + is *_{ARRAY}, undef, 'goto &perlsub when @_ does not exist'; + } +}->(); +sub { + local *_; + goto sub { + is *_{ARRAY}, undef, 'goto &sub when @_ does not exist (local *_)'; + } +}->(); + +# [perl #36521] goto &foo in warn handler could defeat recursion avoider + +{ + my $r = runperl( + stderr => 1, + prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' + ); + like($r, qr/bar/, "goto &foo in warn"); +} + +{ + sub TIESCALAR { bless [pop] } + sub FETCH { $_[0][0] } + tie my $t, "", sub { "cluck up porridge" }; + is eval { sub { goto $t }->() }//$@, 'cluck up porridge', + 'tied arg returning sub ref'; +} + +# v5.31.3-198-gd2cd363728 broke this. goto &XS_sub wasn't restoring +# cx->blk_sub.old_cxsubix. Would panic in pp_return + +{ + # isa is an XS sub + sub g198 { goto &UNIVERSAL::isa } + + sub f198 { + g198([], 1 ); + { + return 1; + } + } + eval { f198(); }; + is $@, "", "v5.31.3-198-gd2cd363728"; +} + +# GH #19188 +# +# 'goto &xs_sub' should provide the correct caller context to an XS sub + +SKIP: +{ + skip "No XS::APItest in miniperl", 6 if is_miniperl(); + skip "No XS::APItest in static perl", 6 if not $Config{usedl}; + + require XS::APItest; + + sub f_19188 { goto &XS::APItest::gimme } + sub g_19188{ f_19188(); } + my ($s, @a); + + f_19188(); + is ($XS::APItest::GIMME_V, 1, 'xs_goto void (#19188)'); + + $s = f_19188(); + is ($XS::APItest::GIMME_V, 2, 'xs_goto scalar (#19188)'); + + @a = f_19188(); + is ($XS::APItest::GIMME_V, 3, 'xs_goto list (#19188)'); + + g_19188(); + is ($XS::APItest::GIMME_V, 1, 'xs_goto indirect void (#19188)'); + + $s = g_19188(); + is ($XS::APItest::GIMME_V, 2, 'xs_goto indirect scalar (#19188)'); + + @a = g_19188(); + is ($XS::APItest::GIMME_V, 3, 'xs_goto indirect list (#19188)'); +} + +# GH #19936 segfault on goto &xs_sub when calling sub is replaced +SKIP: +{ + skip "No XS::APItest in miniperl", 2 if is_miniperl(); + skip "No XS::APItest in static perl", 2 if not $Config{usedl}; + + # utf8::is_utf8() is just an example of an XS sub + sub foo_19936 { *foo_19936 = {}; goto &utf8::is_utf8 } + ok(foo_19936("\x{100}"), "GH #19936 utf8 XS call"); + + # the gimme XS function accesses PL_op, which was null before the fix + sub bar_19936 { *bar_19936 = {}; goto &XS::APItest::gimme } + my @a = bar_19936(); + is($XS::APItest::GIMME_V, 3, "GH #19936 gimme XS call"); +} + +# goto &sub could leave AvARRAY() slots of @_ uninitialised. + +{ + my $i = 0; + my $f = sub { + goto &{ sub {} } unless $i++; + $_[1] = 1; # create a hole + # accessing $_[0] is more for valgrind/ASAN to chew on rather than + # we're too concerned about its value. Or it might give "bizarre + # copy" errors. + is($_[0], undef, "goto and AvARRAY"); + }; + + # first call does goto, which gives &$f a fresh AV in pad[0], + # which formerly allocated an AvARRAY for it, but didn't zero it + $f->(); + # second call creates hole in @_ which used to to be a wild SV pointer + $f->(); +} + + +# Final test: ensure that we saw no deprecation warnings +# ... but rework this to count fatalizations once work is more developed + +is($deprecated, 0, "No 'jump into a construct' warnings seen"); diff --git a/t/op/goto.t b/t/op/goto.t index 230f942eeb79..4fe5eb8379df 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -12,7 +12,8 @@ BEGIN { use warnings; use strict; use Config; -plan tests => 134; +plan tests => 95; + our $TODO; my $deprecated = 0; @@ -57,16 +58,16 @@ is($foo, 4, 'second escape while loop'); my $r = run_perl(prog => 'goto foo;', stderr => 1); like($r, qr/label/, 'cant find label'); -my $ok = 0; +my $thisok = 0; sub foo { goto bar; return; bar: - $ok = 1; + $thisok = 1; } &foo; -ok($ok, 'goto in sub'); +ok($thisok, 'goto in sub'); sub bar { my $x = 'bypass'; @@ -78,7 +79,7 @@ fail('goto bypass'); exit; FINALE: -is(curr_test(), 20, 'FINALE'); +is(curr_test(), 11, 'FINALE'); # does goto LABEL handle block contexts correctly? # note that this scope-hopping differs from last & next, @@ -137,7 +138,7 @@ FORL2: for($y=1; 1;) { # Does goto work correctly within a try block? # (BUG ID 20000313.004) - [perl #2359] -$ok = 0; +my $ok = 0; eval { my $variable = 1; goto LABEL20; @@ -206,65 +207,6 @@ ok($ok, 'works correctly in a nested eval string'); $deprecated = 0; } -# bug #9990 - don't prematurely free the CV we're &going to. - -sub f1 { - my $x; - goto sub { $x=0; ok(1,"don't prematurely free CV\n") } -} -f1(); - -# bug #99850, which is similar - freeing the subroutine we are about to -# go(in)to during a FREETMPS call should not crash perl. - -package _99850 { - sub reftype{} - DESTROY { undef &reftype } - eval { sub { my $guard = bless []; goto &reftype }->() }; -} -like $@, qr/^Goto undefined subroutine &_99850::reftype at /, - 'goto &foo undefining &foo on sub cleanup'; - -# When croaking after discovering that the new CV you're about to goto is -# undef, make sure that the old CV isn't doubly freed. - -package Do_undef { - my $count; - - # creating a new closure here encourages any prematurely freed - # CV to be reallocated - sub DESTROY { undef &undef_sub; my $x = sub { $count } } - - sub f { - $count++; - my $guard = bless []; # trigger DESTROY during goto - *undef_sub = sub {}; - goto &undef_sub - } - - for (1..10) { - eval { f() }; - } - ::is($count, 10, "goto undef_sub safe"); -} - -# make sure that nothing nasty happens if the old CV is freed while -# goto'ing - -package Free_cv { - my $results; - sub f { - no warnings 'redefine'; - *f = sub {}; - goto &g; - } - sub g { $results = "(@_)" } - - f(1,2,3); - ::is($results, "(1 2 3)", "Free_cv"); -} - - # bug #22181 - this used to coredump or make $x undefined, due to # erroneous popping of the inner BLOCK context @@ -307,17 +249,6 @@ returned_label: is($count, 1, 'called i_return_a_label'); ok($ok, 'skipped to returned_label'); -# [perl #29708] - goto &foo could leave foo() at depth two with -# @_ == PL_sv_undef, causing a coredump - - -$r = runperl( - prog => - 'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)', - stderr => 1 - ); -is($r, "ok\n", 'avoid pad without an @_'); - goto moretests; fail('goto moretests'); exit; @@ -326,52 +257,12 @@ bypass: is(curr_test(), 9, 'eval "goto $x"'); -# Test autoloading mechanism. - -sub two { - my ($pack, $file, $line) = caller; # Should indicate original call stats. - is("@_ $pack $file $line", "1 2 3 main $::FILE $::LINE", - 'autoloading mechanism.'); -} - -sub one { - eval <<'END'; - no warnings 'redefine'; - sub one { pass('sub one'); goto &two; fail('sub one tail'); } -END - goto &one; -} - -$::FILE = __FILE__; -$::LINE = __LINE__ + 1; -&one(1,2,3); - { my $wherever = 'NOWHERE'; eval { goto $wherever }; like($@, qr/Can't find label NOWHERE/, 'goto NOWHERE sets $@'); } -# see if a modified @_ propagates -{ - my $i; - package Foo; - sub DESTROY { my $s = shift; ::is($s->[0], $i, "destroy $i"); } - sub show { ::is(+@_, 5, "show $i",); } - sub start { push @_, 1, "foo", {}; goto &show; } - for (1..3) { $i = $_; start(bless([$_]), 'bar'); } -} - -sub auto { - goto &loadit; -} - -sub AUTOLOAD { $ok = 1 if "@_" eq "foo" } - -$ok = 0; -auto("foo"); -ok($ok, 'autoload'); - { my $wherever = 'FINALE'; goto $wherever; @@ -495,34 +386,6 @@ sub DEBUG_TIME() { is($deprecated, 0, 'no warning was emitted'); -# deep recursion with gotos eventually caused a stack reallocation -# which messed up buggy internals that didn't expect the stack to move - -sub recurse1 { - unshift @_, "x"; - no warnings 'recursion'; - goto &recurse2; -} -sub recurse2 { - my $x = shift; - $_[0] ? +1 + recurse1($_[0] - 1) : 0 -} -my $w = 0; -$SIG{__WARN__} = sub { ++$w }; -is(recurse1(500), 500, 'recursive goto &foo'); -is $w, 0, 'no recursion warnings for "no warnings; goto &sub"'; -delete $SIG{__WARN__}; - -# [perl #32039] Chained goto &sub drops data too early. - -sub a32039 { @_=("foo"); goto &b32039; } -sub b32039 { goto &c32039; } -sub c32039 { is($_[0], 'foo', 'chained &goto') } -a32039(); - -# [perl #35214] next and redo re-entered the loop with the wrong cop, -# causing a subsequent goto to crash - { my $r = runperl( stderr => 1, @@ -539,73 +402,6 @@ a32039(); is($r, "ok\n", 'redo and goto'); } -# goto &foo not allowed in evals - -sub null { 1 }; -eval 'goto &null'; -like($@, qr/Can't goto subroutine from an eval-string/, 'eval string'); -eval { goto &null }; -like($@, qr/Can't goto subroutine from an eval-block/, 'eval block'); - -# goto &foo leaves @_ alone when called from a sub -sub returnarg { $_[0] }; -is sub { - local *_ = ["ick and queasy"]; - goto &returnarg; -}->("quick and easy"), "ick and queasy", - 'goto &foo with *_{ARRAY} replaced'; -my @__ = byte_utf8a_to_utf8n("\xc4\x80"); -sub { local *_ = \@__; goto &utf8::decode }->("no thinking aloud"); -is "@__", chr 256, 'goto &xsub with replaced *_{ARRAY}'; - -# And goto &foo should leave reified @_ alone -sub { *__ = \@_; goto &null } -> ("rough and tubbery"); -is ${*__}[0], 'rough and tubbery', 'goto &foo leaves reified @_ alone'; - -# goto &xsub when @_ has nonexistent elements -{ - no warnings "uninitialized"; - local @_ = (); - $#_++; - & {sub { goto &utf8::encode }}; - is @_, 1, 'num of elems in @_ after goto &xsub with nonexistent $_[0]'; - is $_[0], "", 'content of nonexistent $_[0] is modified by goto &xsub'; -} - -# goto &xsub when @_ itself does not exist -undef *_; -eval { & { sub { goto &utf8::encode } } }; -# The main thing we are testing is that it did not crash. But make sure -# *_{ARRAY} was untouched, too. -is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist'; - -# goto &perlsub when @_ itself does not exist [perl #119949] -# This was only crashing when the replaced sub call had an argument list. -# (I.e., &{ sub { goto ... } } did not crash.) -sub { - undef *_; - goto sub { - is *_{ARRAY}, undef, 'goto &perlsub when @_ does not exist'; - } -}->(); -sub { - local *_; - goto sub { - is *_{ARRAY}, undef, 'goto &sub when @_ does not exist (local *_)'; - } -}->(); - - -# [perl #36521] goto &foo in warn handler could defeat recursion avoider - -{ - my $r = runperl( - stderr => 1, - prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' - ); - like($r, qr/bar/, "goto &foo in warn"); -} - TODO: { local $TODO = "[perl #43403] goto() from an if to an else doesn't undo local () changes"; our $global = "unmodified"; @@ -777,12 +573,6 @@ like $@, qr/^Can't find label \0 at /, 'goto $x where $x begins with \0'; eval { goto "\0" }; like $@, qr/^Can't find label \0 at /, 'goto "\0"'; -sub TIESCALAR { bless [pop] } -sub FETCH { $_[0][0] } -tie my $t, "", sub { "cluck up porridge" }; -is eval { sub { goto $t }->() }//$@, 'cluck up porridge', - 'tied arg returning sub ref'; - TODO: { local $::TODO = 'RT #45091: goto in CORE::GLOBAL::exit unsupported'; fresh_perl_is(<<'EOC', "before\ndie handler\n", {stderr => 1}, 'RT #45091: goto in CORE::GLOBAL::EXIT'); @@ -893,89 +683,3 @@ eval { }; is $@,'', 'goto the first parameter of a binary expression [perl #132854]'; -# v5.31.3-198-gd2cd363728 broke this. goto &XS_sub wasn't restoring -# cx->blk_sub.old_cxsubix. Would panic in pp_return - -{ - # isa is an XS sub - sub g198 { goto &UNIVERSAL::isa } - - sub f198 { - g198([], 1 ); - { - return 1; - } - } - eval { f198(); }; - is $@, "", "v5.31.3-198-gd2cd363728"; -} - -# GH #19188 -# -# 'goto &xs_sub' should provide the correct caller context to an XS sub - -SKIP: -{ - skip "No XS::APItest in miniperl", 6 if is_miniperl(); - skip "No XS::APItest in static perl", 6 if not $Config{usedl}; - - require XS::APItest; - - sub f_19188 { goto &XS::APItest::gimme } - sub g_19188{ f_19188(); } - my ($s, @a); - - f_19188(); - is ($XS::APItest::GIMME_V, 1, 'xs_goto void (#19188)'); - - $s = f_19188(); - is ($XS::APItest::GIMME_V, 2, 'xs_goto scalar (#19188)'); - - @a = f_19188(); - is ($XS::APItest::GIMME_V, 3, 'xs_goto list (#19188)'); - - g_19188(); - is ($XS::APItest::GIMME_V, 1, 'xs_goto indirect void (#19188)'); - - $s = g_19188(); - is ($XS::APItest::GIMME_V, 2, 'xs_goto indirect scalar (#19188)'); - - @a = g_19188(); - is ($XS::APItest::GIMME_V, 3, 'xs_goto indirect list (#19188)'); -} - -# GH #19936 segfault on goto &xs_sub when calling sub is replaced -SKIP: -{ - skip "No XS::APItest in miniperl", 2 if is_miniperl(); - skip "No XS::APItest in static perl", 2 if not $Config{usedl}; - - # utf8::is_utf8() is just an example of an XS sub - sub foo_19936 { *foo_19936 = {}; goto &utf8::is_utf8 } - ok(foo_19936("\x{100}"), "GH #19936 utf8 XS call"); - - # the gimme XS function accesses PL_op, which was null before the fix - sub bar_19936 { *bar_19936 = {}; goto &XS::APItest::gimme } - my @a = bar_19936(); - is($XS::APItest::GIMME_V, 3, "GH #19936 gimme XS call"); -} - -# goto &sub could leave AvARRAY() slots of @_ uninitialised. - -{ - my $i = 0; - my $f = sub { - goto &{ sub {} } unless $i++; - $_[1] = 1; # create a hole - # accessing $_[0] is more for valgrind/ASAN to chew on rather than - # we're too concerned about its value. Or it might give "bizarre - # copy" errors. - is($_[0], undef, "goto and AvARRAY"); - }; - - # first call does goto, which gives &$f a fresh AV in pad[0], - # which formerly allocated an AvARRAY for it, but didn't zero it - $f->(); - # second call creates hole in @_ which used to to be a wild SV pointer - $f->(); -}