diff options
| -rw-r--r-- | av.h | 2 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | t/op/caller.t | 13 |
4 files changed, 15 insertions, 4 deletions
@@ -28,7 +28,7 @@ struct xpvav { * real if the array needs to be modified in some way. Functions that * modify fake AVs check both flags to call av_reify() as appropriate. * - * Note that the Perl stack and @DB::args have neither flag set. (Thus, + * Note that the Perl stack has neither flag set. (Thus, * items that go on the stack are never refcounted.) * * These internal details are subject to change any time. AV @@ -3848,7 +3848,7 @@ Perl_init_dbargs(pTHX) "leak" until global destruction. */ av_clear(args); } - AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */ + AvREIFY_only(PL_dbargs); } void @@ -1957,7 +1957,7 @@ PP(pp_caller) AV * const ary = cx->blk_sub.argarray; const int off = AvARRAY(ary) - AvALLOC(ary); - if (!PL_dbargs) + if (!PL_dbargs || AvREAL(PL_dbargs)) Perl_init_dbargs(aTHX); if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) diff --git a/t/op/caller.t b/t/op/caller.t index a92b3eab21..d77088e611 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 81 ); + plan( tests => 82 ); } my @c; @@ -214,6 +214,17 @@ EOP } } +# This also used to leak [perl #97010]: +{ + my $gone; + sub fwib::DESTROY { ++$gone } + package DB; + sub { () = caller(0) }->(); # initialise PL_dbargs + @args = bless[],'fwib'; + sub { () = caller(0) }->(); # clobber @args without initialisation + ::is $gone, 1, 'caller does not leak @DB::args elems when AvREAL'; +} + $::testing_caller = 1; do './op/caller.pl' or die $@; |