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
Comments
From tchrist@jhereg.perl.com local @ARGV = ( ..... ); works. for $i ( 1 .. 5 ) { @ARGV = mkfiles(1..3); $n = 0; sub show { chomp; print "$ARGV: $_\n" } sub other { sub mkfiles { If you run that as is, you get % /usr/src/perl5.005_57/perl -w /tmp/atest 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 And it exits immediately. Considering that local @ARGV = glob("*.[ch]"); is a very useful thing, I should think that you'd like to be able to --tom |
From [Unknown Contact. See original ticket]I don't think that local @ARGV = ( ..... ); works. for $i ( 1 .. 5 ) { @ARGV = mkfiles(1..3); $n = 0; sub show { chomp; print "$ARGV: $_\n" } sub other { sub mkfiles { If you run that as is, you get % /usr/src/perl5.005_57/perl -w /tmp/atest 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 And it exits immediately. Considering that local @ARGV = glob("*.[ch]"); is a very useful thing, I should think that you'd like to be able to --tom |
From @gsarOn Tue, 01 Jun 1999 06:30:24 MDT, Tom Christiansen wrote:
This ought to fix that. Sarathy 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. |
Migrated from rt.perl.org#833 (status was 'resolved')
Searchable as RT833$
The text was updated successfully, but these errors were encountered: