[perl #121242] Fix crash in gp_free when gv is freed

Commit 4571f4a caused the gp to have a refcount of 1, not 0, in
gp_free when the contents of the glob are freed.  This makes
gv_try_downgrade see the gv as a candidate for downgrading in
this example:

sub Fred::AUTOLOAD { $Fred::AUTOLOAD }
undef *{"Fred::AUTOLOAD"};

When the glob is undefined, the sub inside it is freed, and the
gvop ($Fred::AUTOLOAD), when freed, tries to downgrade the glob
(*Fred::AUTOLOAD).  Since it is empty, it deletes it completely from
the containing stash, so the GV is freed out from under gp_free, which
is still using it, causing an assertion failure.

We can trigger a similar condition more explicitly:

$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; undef *{"foo"}'

This bug is nothing new.  On a non-debugging 5.18.2, I get this:

$ perl5.18.2 -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; undef *{"foo"}'
Attempt to free unreferenced glob pointers at -e line 1.
Segmentation fault: 11

That crashes in pp_undef after the call to gp_free, becaues pp_undef
continues to manipulate the GV.

The problem occurs not only with pp_undef, but also with other func-
tions calling gp_free:

sv_setsv_flags:
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; *{"foo"}="bar"'

glob_assign_glob:
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; *{"foo"}=*bar'

sv_unglob, reached through various paths:
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; ${"foo"} = 3'
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; utf8::encode(${"foo"})'
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; open bar, "t/TEST"; ${"foo"} .= <bar>'
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; ${"foo"}++'
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; undef ${"foo"}'
$ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = 3; ${"foo"} =~ s/3/${"foo"} = do {local *bar}; $${"foo"} = bless []; 4/e'

And there are probably more ways to trigger this through sv_unglob.
(I stopped looking when I thought of the fix.)

This patch fixes the problem by protecting the GV using the mortals
stack in functions that call gp_free.  I did not change gp_free
itself, since it is an API function that as yet does not touch the
mortals stack, and I am not sure that should change.  All of its
callers that this patch touches already do sv_2mortal in some cir-
cumstances.

1 files changed, 1 insertions, 0 deletions

diff --git a/pp.c b/pp.c
index a5ce2a865e..4d7ff0939f 100644
--- a/pp.c
+++ b/pp.c
@@ -1024,6 +1024,7 @@ PP(pp_undef)
                 else stash = NULL;
             }
 
+	    SvREFCNT_inc_simple_void_NN(sv_2mortal(sv));
 	    gp_free(MUTABLE_GV(sv));
 	    Newxz(gp, 1, GP);
 	    GvGP_set(sv, gp_ref(gp));