From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 22 Jun 2013 08:16:22 +0000 (-0700)
Subject: Copy scalar refs returned from @INC filters
X-Git-Tag: upstream/5.20.0~2981^2~4
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9b7d7782b9990e579acbba430d00797bfb529804;p=platform%2Fupstream%2Fperl.git

Copy scalar refs returned from @INC filters

This commit:

4464f08ea532be08ea7f0c44d0eb6e285a0c36fb is the first bad commit
commit 4464f08ea532be08ea7f0c44d0eb6e285a0c36fb
Author: Nicholas Clark <nick@ccl4.org>
Date:   Fri Oct 23 16:54:10 2009 +0100

    S_run_user_filter() can use the filter GV itself for the cache buffer.

    This saves allocating an extra SV head and body.

caused this:

$ perl -e '@INC = sub { \$_ }; eval { require foo }; $a = $_;'
Bizarre copy of IO in sassign at -e line 1.

Well, passing the existing string to filter_add causes that string
*itself* to be upgraded to SVt_PVIO, which is clearly not a good thing
if the caller can still reference it.  So we end up with $ bound to an
IO thingy.

And if the referent is a REGEXP, we get a crash during global destruc-
tion, or at least we did until the previous commit, which stopped
REGEXP->PVIO upgrades from being legal.  (Clearly they don’t work.)

The easiest way to fix this is to copy the string into a new scalar,
which then gets upgraded to PVIO.
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 7a2ba07..f68336a 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3842,7 +3842,6 @@ PP(pp_require)
 			if (SvROK(arg) && (SvTYPE(SvRV(arg)) <= SVt_PVLV)
 			    && !isGV_with_GP(SvRV(arg))) {
 			    filter_cache = SvRV(arg);
-			    SvREFCNT_inc_simple_void_NN(filter_cache);
 
 			    if (i < count) {
 				arg = SP[i++];
@@ -3905,10 +3904,7 @@ PP(pp_require)
 		    }
 
 		    filter_has_file = 0;
-		    if (filter_cache) {
-			SvREFCNT_dec(filter_cache);
-			filter_cache = NULL;
-		    }
+		    filter_cache = NULL;
 		    if (filter_state) {
 			SvREFCNT_dec(filter_state);
 			filter_state = NULL;
@@ -4074,7 +4070,10 @@ PP(pp_require)
 	   than hanging another SV from it. In turn, filter_add() optionally
 	   takes the SV to use as the filter (or creates a new SV if passed
 	   NULL), so simply pass in whatever value filter_cache has.  */
-	SV * const datasv = filter_add(S_run_user_filter, filter_cache);
+	SV * const fc = filter_cache ? newSV(0) : NULL;
+	SV *datasv;
+	if (fc) sv_copypv(fc, filter_cache);
+	datasv = filter_add(S_run_user_filter, fc);
 	IoLINES(datasv) = filter_has_file;
 	IoTOP_GV(datasv) = MUTABLE_GV(filter_state);
 	IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub);
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index 6227c4a..e07526c 100644
--- a/t/op/incfilter.t
+++ b/t/op/incfilter.t
@@ -13,7 +13,7 @@ use strict;
 use Config;
 use Filter::Util::Call;
 
-plan(tests => 145);
+plan(tests => 148);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -195,6 +195,22 @@ do [$fh, sub {$_ .= $_ . $_; return;}] or die;
 do \"pass\n(\n'Scalar references are treated as initial file contents'\n)\n"
 or die;
 
+use constant scalarreffee =>
+  "pass\n(\n'Scalar references are treated as initial file contents'\n)\n";
+do \scalarreffee or die;
+is scalarreffee,
+  "pass\n(\n'Scalar references are treated as initial file contents'\n)\n",
+  'and are not gobbled up when read-only';
+
+{
+    local $SIG{__WARN__} = sub {}; # ignore deprecation warning from ?...?
+    do qr/a?, 1/;
+    pass "No crash (perhaps) when regexp ref is returned from inc filter";
+    # Even if that outputs "ok", it may not have passed, as the crash
+    # occurs during globular destruction.  But the crash will result in
+    # this script failing.
+}
+
 open $fh, "<", \"ss('The file is concatenated');";
 
 do [\'pa', $fh] or die;