From: Gurusamy Sarathy Date: Sun, 31 Oct 1999 20:46:02 +0000 (+0000) Subject: make nested ARGV/$^I loops work correctly; fixes several bugs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=18708f5a7334d978ddf7562cb7f58e28bec6e4ed;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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;