IoDIRP may be fake when used in source filters, mark as such

p4raw-id: //depot/perl@4542

diff --git a/sv.c b/sv.c
index 52470e2..6d981d7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3318,10 +3318,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
        {
            io_close((IO*)sv, FALSE);
        }
-       if (IoDIRP(sv)) {
+       if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP))
            PerlDir_close(IoDIRP(sv));
-           IoDIRP(sv) = 0;
-       }
+       IoDIRP(sv) = (DIR*)NULL;
        Safefree(IoTOP_NAME(sv));
        Safefree(IoFMT_NAME(sv));
        Safefree(IoBOTTOM_NAME(sv));
@@ -5940,8 +5939,11 @@ Perl_sv_dup(pTHX_ SV *sstr)
            IoOFP(dstr) = IoIFP(dstr);
        else
            IoOFP(dstr)         = fp_dup(IoOFP(sstr), IoTYPE(sstr));
-       /* XXX PL_rsfp_filters entries have fake IoDIRP() */
-       IoDIRP(dstr)            = dirp_dup(IoDIRP(sstr));
+       /* PL_rsfp_filters entries have fake IoDIRP() */
+       if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
+           IoDIRP(dstr)        = dirp_dup(IoDIRP(sstr));
+       else
+           IoDIRP(dstr)        = IoDIRP(sstr);
        IoLINES(dstr)           = IoLINES(sstr);
        IoPAGE(dstr)            = IoPAGE(sstr);
        IoPAGE_LEN(dstr)        = IoPAGE_LEN(sstr);
@@ -6516,7 +6518,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_ofslen          = proto_perl->Tofslen;
     PL_ofs             = SAVEPVN(proto_perl->Tofs, PL_ofslen);
     PL_defoutgv                = gv_dup_inc(proto_perl->Tdefoutgv);
-    PL_chopset         = proto_perl->Tchopset;
+    PL_chopset         = proto_perl->Tchopset; /* XXX */
     PL_toptarget       = sv_dup_inc(proto_perl->Ttoptarget);
     PL_bodytarget      = sv_dup_inc(proto_perl->Tbodytarget);
     PL_formtarget      = sv_dup(proto_perl->Tformtarget);

diff --git a/sv.h b/sv.h
index 116f178..bd7dac1 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -318,12 +318,13 @@ struct xpvio {
     char       xio_flags;
 };
 
-#define IOf_ARGV 1     /* this fp iterates over ARGV */
-#define IOf_START 2    /* check for null ARGV and substitute '-' */
-#define IOf_FLUSH 4    /* this fp wants a flush after write op */
-#define IOf_DIDTOP 8   /* just did top of form */
-#define IOf_UNTAINT 16  /* consider this fp (and its data) "safe" */
-#define IOf_NOLINE  32 /* slurped a pseudo-line from empty file */
+#define IOf_ARGV       1       /* this fp iterates over ARGV */
+#define IOf_START      2       /* check for null ARGV and substitute '-' */
+#define IOf_FLUSH      4       /* this fp wants a flush after write op */
+#define IOf_DIDTOP     8       /* just did top of form */
+#define IOf_UNTAINT    16      /* consider this fp (and its data) "safe" */
+#define IOf_NOLINE     32      /* slurped a pseudo-line from empty file */
+#define IOf_FAKE_DIRP  64      /* xio_dirp is fake (source filters kludge) */
 
 /* The following macros define implementation-independent predicates on SVs. */
 

diff --git a/toke.c b/toke.c
index 019765b..5011cbb 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1764,7 +1764,8 @@ S_incl_perldb(pTHX)
  * store private buffers and state information.
  *
  * The supplied datasv parameter is upgraded to a PVIO type
- * and the IoDIRP field is used to store the function pointer.
+ * and the IoDIRP field is used to store the function pointer,
+ * and IOf_FAKE_DIRP is enabled on datasv to mark this as such.
  * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
  * private use must be set using malloc'd pointers.
  */
@@ -1782,6 +1783,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     if (!SvUPGRADE(datasv, SVt_PVIO))
         Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
     IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+    IoFLAGS(datasv) |= IOf_FAKE_DIRP;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
                          funcp, SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
@@ -1794,12 +1796,15 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
 void
 Perl_filter_del(pTHX_ filter_t funcp)
 {
+    SV *datasv;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
-    if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
-       IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
+    datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
+    if (IoDIRP(datasv) == (DIR*)funcp) {
+       IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
+       IoDIRP(datasv) = (DIR*)NULL;
        sv_free(av_pop(PL_rsfp_filters));
 
         return;