Skip to content

Commit

Permalink
[perl #97020] Carp (actually caller) leaking memory
Browse files Browse the repository at this point in the history
Commit eff7e72 (Detect incomplete caller overrides in Carp) used
this little trick for detecting a @db::args that an overridden
caller() failed to set:

+  @Args = \$i; # A sentinal, which no-one else has the address of

But there is a bug in caller().  The first time caller tries to write
to @db::args, it calls Perl_init_dbargs first.  That function checks
whether @db::args is AvREAL, in case someone has assigned to it, and
takes appropriate measures.  But caller doesn’t bother calling
Perl_init_dbargs more than once.  So manually-assigned items in
@db::args would leak, starting with the *second* call to caller.

Commit eff7e72 triggered that bug, resulting in a regression in
Carp, in that it started leaking.  eff7e72 was backported to 5.12.2
with commit 9770594, so in both 5.12 and 5.14 Carp is affected.

This bug (the caller bug, not Carp’s triggering thereof) also affects
any caller overrides that set @db::args themselves, if there are
alternate calls to the overridden caller and CORE::caller.

This commit fixes that by changing the if (!PL_dbargs) condition
in pp_caller to if (!PL_dbargs || AvREAL(PL_dbargs)).  I.e., if
@Args is either uninitialised or AvREAL then call Perl_init_dbargs.
Perl_init_dbargs also has a bug in it, that this fixes: The array not
only needs AvREAL turned off, but also AvREIFY turned on, so that
assignments to it that occur after its initialisation turn AvREAL back
on again.  (In fact, Larry Wall added a comment suggesting this back
in perl 5.000.)
  • Loading branch information
Father Chrysostomos authored and rafl committed Aug 26, 2011
1 parent e26bac9 commit ba4a1c0
Show file tree
Hide file tree
Showing 4 changed files with 15 additions and 4 deletions.
2 changes: 1 addition & 1 deletion av.h
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion perl.c
Expand Up @@ -3841,7 +3841,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
Expand Down
2 changes: 1 addition & 1 deletion pp_ctl.c
Expand Up @@ -1959,7 +1959,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)
Expand Down
13 changes: 12 additions & 1 deletion t/op/caller.t
Expand Up @@ -5,7 +5,7 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
plan( tests => 81 );
plan( tests => 82 );
}

my @c;
Expand Down Expand Up @@ -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 $@;

0 comments on commit ba4a1c0

Please sign in to comment.