<ARGV> bug

[p5pRT]

Migrated from rt.perl.org#833 (status was 'resolved')

Searchable as RT833$

[p5pRT]

From [email protected]

  local @​ARGV = ( ..... );
  while (<ARGV>) {
  ....
  }

works.

  for $i ( 1 .. 5 ) {
  $file = mkfiles($i);
  open(FH, "> $file") || die "can't create $file​: $!";
  print FH "this is file #$i\n";
  close(FH) || die "Can't close $file​: $!";
  }

  @​ARGV = mkfiles(1..3);

  $n = 0;
  while (<>) {
  if ($n++ == 2) {
  other();
  }
  show();
  }

  sub show { chomp; print "$ARGV​: $_\n" }

  sub other {
  warn "Calling other\n";
  ###local *ARGV;
  local @​ARGV = mkfiles(5, 4);
  while (<>) {
  show();
  }
  }

  sub mkfiles {
  my @​files = map { "scratch.$_" } @​_;
  return wantarray ? @​files : $files[-1];
  }

If you run that as is, you get

  % /usr/src/perl5.005_57/perl -w /tmp/atest
  scratch.1​: this is file #1
  scratch.2​: this is file #2
  Calling other
  scratch.5​: this is file #5
  scratch.4​: this is file #4
  Use of uninitialized value at /tmp/atest line 19, <> line 5.
  Use of uninitialized value at /tmp/atest line 19, <> line 5.
  scratch.4​:
  ^C

Yes, it hangs reading from stdin (^T reveals

  load​: 0.09 cmd​: perl 11460 [ttyin] 0.00u 0.02s 0% 832k

If you comment out the local *ARGV, you get

  % /usr/src/perl5.005_57/perl -w /tmp/atest
  scratch.1​: this is file #1
  scratch.2​: this is file #2
  Calling other
  Use of uninitialized value at /tmp/atest line 19, <> line 3.
  Use of uninitialized value at /tmp/atest line 19, <> line 3.
  scratch.3​:

And it exits immediately.

Considering that

  local @​ARGV = glob("*.[ch]");
  local $^I = ".orig";
  while (<>) {
  stuff;
  print
  }

is a very useful thing, I should think that you'd like to be able to
get your old $ARGV/@​ARGV/ARGV state back again this way.

--tom

[p5pRT]

From [Unknown Contact. See original ticket]

I don't think that

  local @​ARGV = ( ..... );
  while (<ARGV>) {
  ....
  }

works.

  for $i ( 1 .. 5 ) {
  $file = mkfiles($i);
  open(FH, "> $file") || die "can't create $file​: $!";
  print FH "this is file #$i\n";
  close(FH) || die "Can't close $file​: $!";
  }

  @​ARGV = mkfiles(1..3);

  $n = 0;
  while (<>) {
  if ($n++ == 2) {
  other();
  }
  show();
  }

  sub show { chomp; print "$ARGV​: $_\n" }

  sub other {
  warn "Calling other\n";
  ###local *ARGV;
  local @​ARGV = mkfiles(5, 4);
  while (<>) {
  show();
  }
  }

  sub mkfiles {
  my @​files = map { "scratch.$_" } @​_;
  return wantarray ? @​files : $files[-1];
  }

If you run that as is, you get

  % /usr/src/perl5.005_57/perl -w /tmp/atest
  scratch.1​: this is file #1
  scratch.2​: this is file #2
  Calling other
  scratch.5​: this is file #5
  scratch.4​: this is file #4
  Use of uninitialized value at /tmp/atest line 19, <> line 5.
  Use of uninitialized value at /tmp/atest line 19, <> line 5.
  scratch.4​:
  ^C

Yes, it hangs reading from stdin (^T reveals

  load​: 0.09 cmd​: perl 11460 [ttyin] 0.00u 0.02s 0% 832k

If you comment out the local *ARGV, you get

  % /usr/src/perl5.005_57/perl -w /tmp/atest
  scratch.1​: this is file #1
  scratch.2​: this is file #2
  Calling other
  Use of uninitialized value at /tmp/atest line 19, <> line 3.
  Use of uninitialized value at /tmp/atest line 19, <> line 3.
  scratch.3​:

And it exits immediately.

Considering that

  local @​ARGV = glob("*.[ch]");
  local $^I = ".orig";
  while (<>) {
  stuff;
  print
  }

is a very useful thing, I should think that you'd like to be able to
get your old $ARGV/@​ARGV/ARGV state back again this way.

--tom

[p5pRT]

From @gsar

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

Inline Patch

-----------------------------------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.