[perl #93320] localising @DB::args leads to coredump

This script, from the RT ticket, crashes:

#!/usr/bin/perl
sub cl{
    package DB;
    @DB::args = ();
    return caller(shift);
}

sub f{
    local @DB::args;
    my @z = cl($_) for (1..3);
}

f(1,2,3); f(1,2,3);
__END__

PL_dbargs is not refcounted, and it’s not set until pp_caller first
tries to write to it.  If that happens when @DB::args is localised,
then the array will be freed on scope exit, leaving PL_dbargs pointing
to a freed SV.

This crash can be reproduced more simply this way:

sub {
  package DB;
  ()=caller(0);
  undef *DB::args;
  ()=caller(0);
}->();

So, basically, pp_caller has to re-fetch PL_dbargs from the %DB::
stash each time it sets it.  It cannot rely on the cached value.

(So now I’m wondering whether we even need PL_dbargs.)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 63d9bd5..6ba039e 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -437,6 +437,11 @@ Calling an undefined anonymous subroutine (e.g., what $x holds after
 C<undef &{$x = sub{}}>) used to cause a "Not a CODE reference" error, which
 has been corrected to "Undefined subroutine called" [perl #71154].
 
+=item *
+
+Causing C<@DB::args> to be freed between uses of C<caller> no longer
+results in a crash [perl #93320].
+
 =back
 
 =head1 Known Problems

diff --git a/pp_ctl.c b/pp_ctl.c
index dc1b055..a239f10 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1957,8 +1957,7 @@ PP(pp_caller)
        AV * const ary = cx->blk_sub.argarray;
        const int off = AvARRAY(ary) - AvALLOC(ary);
 
-       if (!PL_dbargs || AvREAL(PL_dbargs))
-           Perl_init_dbargs(aTHX);
+       Perl_init_dbargs(aTHX);
 
        if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
            av_extend(PL_dbargs, AvFILLp(ary) + off);

diff --git a/t/op/caller.t b/t/op/caller.t
index d77088e..4fcc851 100644 (file)
--- 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 => 82 );
+    plan( tests => 83 );
 }
 
 my @c;
@@ -225,6 +225,15 @@ EOP
     ::is $gone, 1, 'caller does not leak @DB::args elems when AvREAL';
 }
 
+# And this crashed [perl #93320]:
+sub {
+  package DB;
+  ()=caller(0);
+  undef *DB::args;
+  ()=caller(0);
+}->();
+pass 'No crash when @DB::args is freed between caller calls';
+
 $::testing_caller = 1;
 
 do './op/caller.pl' or die $@;