Don’t free initial src from @INC sub too early

As noted in <20130919225357.GA18474@mars.tony.develop-help.com>, com-
mit 839a0e5 introduces uninitialized warnings (and sometimes other
warnings) in inccode.t.

What actually is happening is that \PVBM is no longer being inlined
and returning the same reference each time, but is returning a new
mortal reference.  Commit 839a0e5 uncovers an existing bug.

A sub in @INC can return a reference to a scalar containing initial
source code.  That returned value would be freed prematurely if it was
not referenced elsewhere.

We have to increment its reference count before leaving the scope, and
then mortalise it afterwards.

diff --git a/pp_ctl.c b/pp_ctl.c
index c4123d2..2144fab 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3931,10 +3931,16 @@ PP(pp_require)
                        SP--;
                    }
 
+                   /* FREETMPS may free our filter_cache */
+                   SvREFCNT_inc_simple_void(filter_cache);
+
                    PUTBACK;
                    FREETMPS;
                    LEAVE_with_name("call_INC");
 
+                   /* Now re-mortalize it. */
+                   sv_2mortal(filter_cache);
+
                    /* Adjust file name if the hook has set an %INC entry.
                       This needs to happen after the FREETMPS above.  */
                    svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);

diff --git a/t/op/inccode.t b/t/op/inccode.t
index d34e735..b00959c 100644 (file)
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -21,7 +21,7 @@ unless (is_miniperl()) {
 
 use strict;
 
-plan(tests => 60 + !is_miniperl() * (3 + 14 * $can_fork));
+plan(tests => 61 + !is_miniperl() * (3 + 14 * $can_fork));
 
 sub get_temp_fh {
     my $f = tempfile();
@@ -261,6 +261,12 @@ shift @INC;
     shift @INC;
 }
 
+unshift @INC, sub { \(my $tmp = '$_ = "are temps freed prematurely?"') };
+eval { require foom };
+is $_||$@, "are temps freed prematurely?",
+           "are temps freed prematurely when returned from inc filters?";
+shift @INC;
+
 exit if is_miniperl();
 
 SKIP: {