make nested ARGV/$^I loops work correctly; fixes several bugs

in the way ARGV state was handled in readline(); writing a
subroutine to do inplace edits is now possible, provided *ARGV,
*ARGVOUT, $^I and $_ are localized where needed

p4raw-id: //depot/perl@4502

diff --git a/MANIFEST b/MANIFEST
index de3c0f7..7191f88 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1146,6 +1146,7 @@ t/io/dup.t                See if >& works right
 t/io/fs.t              See if directory manipulations work
 t/io/inplace.t         See if inplace editing works
 t/io/iprefix.t         See if inplace editing works with prefixes
+t/io/nargv.t           See if nested ARGV stuff works
 t/io/open.t            See if open works
 t/io/openpid.t         See if open works for subprocesses
 t/io/pipe.t            See if secure pipes work

diff --git a/doio.c b/doio.c
index d9fd6df..b340ec6 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -484,9 +484,15 @@ Perl_nextargv(pTHX_ register GV *gv)
 #endif
     Uid_t fileuid;
     Gid_t filegid;
+    IO *io = GvIOp(gv);
 
     if (!PL_argvoutgv)
        PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+    if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
+       IoFLAGS(io) &= ~IOf_START;
+       if (PL_inplace)
+           av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv));
+    }
     if (PL_filemode & (S_ISUID|S_ISGID)) {
        PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
@@ -610,11 +616,12 @@ Perl_nextargv(pTHX_ register GV *gv)
                SETERRNO(0,0);          /* in case sprintf set errno */
 #ifdef VMS
                if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
-                 O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) { 
+                 O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp))
 #else
                if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
-                            O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
+                            O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp))
 #endif
+               {
                    if (ckWARN_d(WARN_INPLACE)) 
                        Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s",
                          PL_oldname, Strerror(errno) );
@@ -657,8 +664,16 @@ Perl_nextargv(pTHX_ register GV *gv)
            }
        }
     }
+    if (io && (IoFLAGS(io) & IOf_ARGV))
+       IoFLAGS(io) |= IOf_START;
     if (PL_inplace) {
        (void)do_close(PL_argvoutgv,FALSE);
+       if (io && (IoFLAGS(io) & IOf_ARGV) && AvFILLp(PL_argvout_stack) >= 0) {
+           GV *oldout = (GV*)av_pop(PL_argvout_stack);
+           setdefout(oldout);
+           SvREFCNT_dec(oldout);
+           return Nullfp;
+       }
        setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
     }
     return Nullfp;

diff --git a/embedvar.h b/embedvar.h
index 94f93b0..3795432 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -191,6 +191,7 @@
 #define PL_an                  (PERL_GET_INTERP->Ian)
 #define PL_archpat_auto                (PERL_GET_INTERP->Iarchpat_auto)
 #define PL_argvgv              (PERL_GET_INTERP->Iargvgv)
+#define PL_argvout_stack       (PERL_GET_INTERP->Iargvout_stack)
 #define PL_argvoutgv           (PERL_GET_INTERP->Iargvoutgv)
 #define PL_basetime            (PERL_GET_INTERP->Ibasetime)
 #define PL_beginav             (PERL_GET_INTERP->Ibeginav)
@@ -449,6 +450,7 @@
 #define PL_an                  (vTHX->Ian)
 #define PL_archpat_auto                (vTHX->Iarchpat_auto)
 #define PL_argvgv              (vTHX->Iargvgv)
+#define PL_argvout_stack       (vTHX->Iargvout_stack)
 #define PL_argvoutgv           (vTHX->Iargvoutgv)
 #define PL_basetime            (vTHX->Ibasetime)
 #define PL_beginav             (vTHX->Ibeginav)
@@ -709,6 +711,7 @@
 #define PL_Ian                 PL_an
 #define PL_Iarchpat_auto       PL_archpat_auto
 #define PL_Iargvgv             PL_argvgv
+#define PL_Iargvout_stack      PL_argvout_stack
 #define PL_Iargvoutgv          PL_argvoutgv
 #define PL_Ibasetime           PL_basetime
 #define PL_Ibeginav            PL_beginav

diff --git a/intrpvar.h b/intrpvar.h
index 1d34a81..24ff54e 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -66,6 +66,7 @@ PERLVAR(Istderrgv,    GV *)
 PERLVAR(Idefgv,                GV *)
 PERLVAR(Iargvgv,       GV *)
 PERLVAR(Iargvoutgv,    GV *)
+PERLVAR(Iargvout_stack,        AV *)
 
 /* shortcuts to regexp stuff */
 /* this one needs to be moved to thrdvar.h and accessed via

diff --git a/objXSUB.h b/objXSUB.h
index 735ca0a..7b3a0a0 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -48,6 +48,8 @@
 #define PL_archpat_auto                (*Perl_Iarchpat_auto_ptr(aTHXo))
 #undef  PL_argvgv
 #define PL_argvgv              (*Perl_Iargvgv_ptr(aTHXo))
+#undef  PL_argvout_stack
+#define PL_argvout_stack       (*Perl_Iargvout_stack_ptr(aTHXo))
 #undef  PL_argvoutgv
 #define PL_argvoutgv           (*Perl_Iargvoutgv_ptr(aTHXo))
 #undef  PL_basetime

diff --git a/perl.c b/perl.c
index 8324d52..a35cdd7 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2767,6 +2767,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        for (; argc > 0; argc--,argv++) {
            av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
        }
+       PL_argvout_stack = newAV();
     }
     if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
        HV *hv;

diff --git a/pp_hot.c b/pp_hot.c
index 6f9528a..ecaed7b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1085,9 +1085,9 @@ Perl_do_readline(pTHX)
        if (!fp) {
            if (IoFLAGS(io) & IOf_ARGV) {
                if (IoFLAGS(io) & IOf_START) {
-                   IoFLAGS(io) &= ~IOf_START;
                    IoLINES(io) = 0;
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
+                       IoFLAGS(io) &= ~IOf_START;
                        do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
                        sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
                        SvSETMAGIC(GvSV(PL_last_in_gv));
@@ -1098,7 +1098,6 @@ Perl_do_readline(pTHX)
                fp = nextargv(PL_last_in_gv);
                if (!fp) { /* Note: fp != IoIFP(io) */
                    (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
-                   IoFLAGS(io) |= IOf_START;
                }
            }
            else if (type == OP_GLOB) {
@@ -1296,7 +1295,6 @@ Perl_do_readline(pTHX)
                if (fp)
                    continue;
                (void)do_close(PL_last_in_gv, FALSE);
-               IoFLAGS(io) |= IOf_START;
            }
            else if (type == OP_GLOB) {
                if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {

diff --git a/scope.c b/scope.c
index e86a9fe..51aeed2 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -279,9 +279,14 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
     if (empty) {
        register GP *gp;
 
+       Newz(602, gp, 1, GP);
+
        if (GvCVu(gv))
            PL_sub_generation++;        /* taking a method out of circulation */
-       Newz(602, gp, 1, GP);
+       else if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
+           gp->gp_io = newIO();
+           IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
+       }
        GvGP(gv) = gp_ref(gp);
        GvSV(gv) = NEWSV(72,0);
        GvLINE(gv) = PL_curcop->cop_line;