Front page | perl.perl5.porters |
Postings from October 1999
Re: [ID 19990601.107] <ARGV> bug
From:
Gurusamy Sarathy
Date:
October 31, 1999 13:13
Subject:
Re: [ID 19990601.107] <ARGV> bug
Message ID:
199910312119.NAA05849@activestate.com
On Tue, 01 Jun 1999 06:30:24 MDT, Tom Christiansen wrote:
>I don't think that
>
> local @ARGV = ( ..... );
> while (<ARGV>) {
> ....
> }
>
>works.
[..testcase snipped..]
This ought to fix that.
Sarathy
gsar@ActiveState.com
-----------------------------------8<-----------------------------------
Change 4502 by gsar@auger on 1999/10/31 20:46:02
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
Affected files ...
... //depot/perl/MANIFEST#208 edit
... //depot/perl/doio.c#81 edit
... //depot/perl/embedvar.h#78 edit
... //depot/perl/intrpvar.h#49 edit
... //depot/perl/objXSUB.h#76 edit
... //depot/perl/perl.c#184 edit
... //depot/perl/pp_hot.c#141 edit
... //depot/perl/scope.c#55 edit
Differences ...
==== //depot/perl/MANIFEST#208 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Sun Oct 31 12:46:06 1999
+++ perl/MANIFEST Sun Oct 31 12:46:06 1999
@@ -1146,6 +1146,7 @@
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
==== //depot/perl/doio.c#81 (text) ====
Index: perl/doio.c
--- perl/doio.c.~1~ Sun Oct 31 12:46:06 1999
+++ perl/doio.c Sun Oct 31 12:46:06 1999
@@ -484,9 +484,15 @@
#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 @@
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 @@
}
}
}
+ 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;
==== //depot/perl/embedvar.h#78 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Sun Oct 31 12:46:06 1999
+++ perl/embedvar.h Sun Oct 31 12:46:06 1999
@@ -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
==== //depot/perl/intrpvar.h#49 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h.~1~ Sun Oct 31 12:46:06 1999
+++ perl/intrpvar.h Sun Oct 31 12:46:06 1999
@@ -66,6 +66,7 @@
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
==== //depot/perl/objXSUB.h#76 (text+w) ====
Index: perl/objXSUB.h
--- perl/objXSUB.h.~1~ Sun Oct 31 12:46:06 1999
+++ perl/objXSUB.h Sun Oct 31 12:46:06 1999
@@ -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
==== //depot/perl/perl.c#184 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Sun Oct 31 12:46:06 1999
+++ perl/perl.c Sun Oct 31 12:46:06 1999
@@ -2767,6 +2767,7 @@
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;
==== //depot/perl/pp_hot.c#141 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c.~1~ Sun Oct 31 12:46:06 1999
+++ perl/pp_hot.c Sun Oct 31 12:46:06 1999
@@ -1085,9 +1085,9 @@
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 @@
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 @@
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)) {
==== //depot/perl/scope.c#55 (text) ====
Index: perl/scope.c
--- perl/scope.c.~1~ Sun Oct 31 12:46:06 1999
+++ perl/scope.c Sun Oct 31 12:46:06 1999
@@ -279,9 +279,14 @@
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;
End of Patch.
Change 4503 by gsar@auger on 1999/10/31 20:56:06
change#4502 was missing a file
Affected files ...
... //depot/perl/t/io/nargv.t#1 add
Differences ...
==== //depot/perl/t/io/nargv.t#1 (xtext) ====
Index: perl/t/io/nargv.t
--- perl/t/io/nargv.t.~1~ Sun Oct 31 12:59:16 1999
+++ perl/t/io/nargv.t Sun Oct 31 12:59:16 1999
@@ -0,0 +1,63 @@
+#!./perl
+
+print "1..5\n";
+
+my $j = 1;
+for $i ( 1,2,5,4,3 ) {
+ $file = mkfiles($i);
+ open(FH, "> $file") || die "can't create $file: $!";
+ print FH "not ok " . $j++ . "\n";
+ close(FH) || die "Can't close $file: $!";
+}
+
+
+{
+ local *ARGV;
+ local $^I = '.bak';
+ local $_;
+ @ARGV = mkfiles(1..3);
+ $n = 0;
+ while (<>) {
+ print STDOUT "# initial \@ARGV: [@ARGV]\n";
+ if ($n++ == 2) {
+ other();
+ }
+ show();
+ }
+}
+
+$^I = undef;
+@ARGV = mkfiles(1..3);
+$n = 0;
+while (<>) {
+ print STDOUT "#final \@ARGV: [@ARGV]\n";
+ if ($n++ == 2) {
+ other();
+ }
+ show();
+}
+
+sub show {
+ #warn "$ARGV: $_";
+ s/^not //;
+ print;
+}
+
+sub other {
+ print STDOUT "# Calling other\n";
+ local *ARGV;
+ local *ARGVOUT;
+ local $_;
+ @ARGV = mkfiles(5, 4);
+ while (<>) {
+ print STDOUT "# inner \@ARGV: [@ARGV]\n";
+ show();
+ }
+}
+
+sub mkfiles {
+ my @files = map { "scratch.$_" } @_;
+ return wantarray ? @files : $files[-1];
+}
+
+END { unlink map { ($_, "$_.bak") } mkfiles(1..5) }
End of Patch.
-
Re: [ID 19990601.107] <ARGV> bug
by Gurusamy Sarathy