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 (file)
--- 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 (file)
--- 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;