Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

<ARGV> bug #33

Closed
p5pRT opened this issue Jun 1, 1999 · 3 comments
Closed

<ARGV> bug #33

p5pRT opened this issue Jun 1, 1999 · 3 comments

Comments

@p5pRT
Copy link

p5pRT commented Jun 1, 1999

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

Searchable as RT833$

@p5pRT
Copy link
Author

p5pRT commented Jun 1, 1999

From tchrist@jhereg.perl.com

  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
Copy link
Author

p5pRT commented Jun 1, 1999

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
Copy link
Author

p5pRT commented Oct 31, 1999

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.

@p5pRT p5pRT closed this as completed Nov 28, 2003
This was referenced Oct 18, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant