Add more tests for the builtin source filter implementation, and fix

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 5288c66..364a1d5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3220,7 +3220,8 @@ PP(pp_require)
                            }
 
                            if (!tryrsfp) {
-                               tryrsfp = PerlIO_open("/dev/null", PERL_SCRIPT_MODE);
+                               tryrsfp = PerlIO_open(BIT_BUCKET,
+                                                     PERL_SCRIPT_MODE);
                            }
                        }
                        SP--;
@@ -3363,7 +3364,7 @@ PP(pp_require)
     PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
-    SAVECOPWARNINGS(&PL_compiling);
+    SAVECOMPILEWARNINGS();
     if (PL_dowarn & G_WARN_ALL_ON)
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
@@ -3463,7 +3464,7 @@ PP(pp_entereval)
     PL_hints = PL_op->op_targ;
     if (saved_hh)
        GvHV(PL_hintgv) = saved_hh;
-    SAVECOPWARNINGS(&PL_compiling);
+    SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (specialCopIO(PL_curcop->cop_io))
@@ -4537,14 +4538,23 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     SV * const filter_state = (SV *)IoTOP_GV(datasv);
     SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int len = 0;
-
+    /* Filter API says that the filter appends to the contents of the buffer.
+       Usually the buffer is "", so the details don't matter. But if it's not,
+       then clearly what it contains is already filtered by this filter, so we
+       don't want to pass it in a second time.
+       I'm going to use a mortal in case the upstream filter croaks.  */
+    SV *const upstream
+       = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv))
+       ? sv_newmortal() : buf_sv;
+
+    SvUPGRADE(upstream, SVt_PV);
     /* I was having segfault trouble under Linux 2.2.5 after a
        parse error occured.  (Had to hack around it with a test
        for PL_error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
     if (filter_has_file) {
-       len = FILTER_READ(idx+1, buf_sv, maxlen);
+       len = FILTER_READ(idx+1, upstream, maxlen);
     }
 
     if (filter_sub && len >= 0) {
@@ -4556,7 +4566,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        SAVETMPS;
        EXTEND(SP, 2);
 
-       DEFSV = buf_sv;
+       DEFSV = upstream;
        PUSHMARK(SP);
        PUSHs(sv_2mortal(newSViv(maxlen)));
        if (filter_state) {
@@ -4595,6 +4605,9 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        filter_del(S_run_user_filter);
     }
 
+    if (upstream != buf_sv) {
+       sv_catsv(buf_sv, upstream);
+    }
     return len;
 }