Skip Menu |
Report information
Id: 833
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: tchrist [at] jhereg.perl.com
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: medium
Type: (no value)
Perl Version: (no value)
Fixed In: (no value)



To: perlbug [...] jhereg.perl.com
Subject: <ARGV> bug
Date: Tue, 01 Jun 1999 06:30:24 -0600
From: Tom Christiansen <tchrist [...] jhereg.perl.com>
Download (untitled) / with headers
text/plain 1.6k
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
Subject: [ID 19990601.107] <ARGV> bug
To: perl5-porters [...] perl.org
From: Tom Christiansen <tchrist [...] jhereg.perl.com>
Date: Tue, 01 Jun 1999 06:30:24 -0600
Download (untitled) / with headers
text/plain 1.7k
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
To: tchrist [...] perl.com
Cc: perl5-porters [...] perl.org, gsar [...] activestate.com
Subject: Re: [ID 19990601.107] <ARGV> bug
Date: Sun, 31 Oct 1999 13:19:17 -0800
From: Gurusamy Sarathy <gsar [...] ActiveState.com>
Download (untitled) / with headers
text/plain 8.2k
On Tue, 01 Jun 1999 06:30:24 MDT, Tom Christiansen wrote: Show quoted text
>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.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org