if (!io)
return TRUE;
+ else if (ckWARN(WARN_IO)
+ && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ || IoIFP(io) == PerlIO_stderr()))
+ {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+ SvPV_nolen(sv));
+ }
while (IoIFP(io)) {
dTHR;
GV *tmpgv;
GV *othergv;
+ IO *io;
sv_setpvn(get_sv("\"", TRUE), " ", 1);
PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
GvMULTI_on(PL_stdingv);
- IoIFP(GvIOp(PL_stdingv)) = PerlIO_stdin();
+ io = GvIOp(PL_stdingv);
+ IoIFP(io) = PerlIO_stdin();
tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_stdingv));
+ GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
GvMULTI_on(tmpgv);
- IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = PerlIO_stdout();
+ io = GvIOp(tmpgv);
+ IoOFP(io) = IoIFP(io) = PerlIO_stdout();
setdefout(tmpgv);
tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_defoutgv));
+ GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
GvMULTI_on(othergv);
- IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = PerlIO_stderr();
+ io = GvIOp(othergv);
+ IoOFP(io) = IoIFP(io) = PerlIO_stderr();
tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
+ GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
PL_statname = NEWSV(66,0); /* last filename we did stat on */
buffering mishaps suffered by users unaware of how Perl internally
handles I/O.
+=head2 Better diagnostics on meaningless filehandle operations
+
+Constructs such as C<open(E<lt>FHE<gt>)> and C<close(E<lt>FHE<gt>)>
+are compile time errors. Attempting to read from filehandles that
+were opened only for writing will now produce warnings (just as
+writing to read-only filehandles does).
+
=head1 Supported Platforms
=over 4
by Perl. This combination appears in an interpolated variable or a
C<'>-delimited regular expression.
-=item Unrecognized escape \\%c passed through
+=item Filehandle %s opened only for output
-(W) You used a backslash-character combination which is not recognized
-by Perl.
+(W) You tried to read from a filehandle opened only for writing. If you
+intended it to be a read-write filehandle, you needed to open it with
+"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
+you intended only to read from the file, use "E<lt>". See
+L<perlfunc/open>.
=item Missing command in piped open
(W) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
construction, but the command was missing or blank.
+=item Unrecognized escape \\%c passed through
+
+(W) You used a backslash-character combination which is not recognized
+by Perl.
+
=item defined(@array) is deprecated
(D) defined() is not usually useful on arrays because it checks for an
You need to do an open() or a socket() call, or call a constructor from
the FileHandle package.
-=item Filehandle %s opened for only input
+=item Filehandle %s opened only for input
(W) You tried to write on a read-only filehandle. If you
intended it to be a read-write filehandle, you needed to open it with
you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See
L<perlfunc/open>.
-=item Filehandle opened for only input
+=item Filehandle %s opened only for output
-(W) You tried to write on a read-only filehandle. If you
+(W) You tried to read from a filehandle opened only for writing. If you
intended it to be a read-write filehandle, you needed to open it with
"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
-you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See
+you intended only to read from the file, use "E<lt>". See
L<perlfunc/open>.
=item Final $ should be \$ or $name
One possible workaround is to force Perl to use magical string
increment by prepending "0" to your numbers.
-=item Read on closed filehandle E<lt>%sE<gt>
+=item Read on closed filehandle %s
(W) The filehandle you're reading from got itself closed sometime before now.
Check your logic flow.
So put in parentheses to say what you really mean.
-=item Write on closed filehandle
+=item Write on closed filehandle %s
(W) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
if (!(io = GvIO(gv))) {
if (ckWARN(WARN_UNOPENED)) {
SV* sv = sv_newmortal();
- gv_fullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
+ SvPV(sv,n_a));
}
-
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED, WARN_IO)) {
SV* sv = sv_newmortal();
- gv_fullname3(sv, gv, Nullch);
+ gv_efullname3(sv, gv, Nullch);
if (IoIFP(io))
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input",
+ SvPV(sv,n_a));
else if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "print on closed filehandle %s",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "print on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else if (type == OP_GLOB)
SP--;
+ else if (ckWARN(WARN_IO) /* stdout/stderr or other write fh */
+ && (IoTYPE(io) == '>' || fp == PerlIO_stdout()
+ || fp == PerlIO_stderr()))
+ {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, PL_last_in_gv, Nullch);
+ Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+ SvPV_nolen(sv));
+ }
}
if (!fp) {
if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_CLOSED, "glob failed (can't start child: %s)",
- Strerror(errno));
- else
- Perl_warner(aTHX_ WARN_CLOSED, "Read on closed filehandle <%s>",
- GvENAME(PL_last_in_gv));
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "glob failed (can't start child: %s)",
+ Strerror(errno));
+ else {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, PL_last_in_gv, Nullch);
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "Read on closed filehandle %s",
+ SvPV_nolen(sv));
+ }
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
fp = IoOFP(io);
if (!fp) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
if (IoIFP(io))
- Perl_warner(aTHX_ WARN_IO, "Filehandle only opened for input");
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input",
+ SvPV_nolen(sv));
else if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "Write on closed filehandle");
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "Write on closed filehandle %s", SvPV_nolen(sv));
}
PUSHs(&PL_sv_no);
}
sv = NEWSV(0,0);
if (!(io = GvIO(gv))) {
if (ckWARN(WARN_UNOPENED)) {
- gv_fullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_UNOPENED,
+ "Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- gv_fullname3(sv, gv, Nullch);
+ gv_efullname3(sv, gv, Nullch);
if (IoIFP(io))
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input",
+ SvPV(sv,n_a));
else if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "printf on closed filehandle %s",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "printf on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
if (length == 0 && PerlIO_error(IoIFP(io)))
length = -1;
}
- if (length < 0)
+ if (length < 0) {
+ if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ || IoIFP(io) == PerlIO_stderr())
+ {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+ SvPV_nolen(sv));
+ }
goto say_undef;
+ }
SvCUR_set(bufsv, length+offset);
*SvEND(bufsv) = '\0';
(void)SvPOK_only(bufsv);
Filehandle %s opened only for input
print STDIN "abc" ;
+ Filehandle %s opened only for output
+ print <STDOUT> ;
print on closed filehandle %s
close STDIN ; print STDIN "abc" ;
Reference found where even-sized list expected
$X = [ 1 ..3 ];
- Read on closed filehandle <%s>
+ Read on closed filehandle %s
close STDIN ; $a = <STDIN>;
Deep recursion on subroutine \"%s\"
# pp_hot.c
use warning 'io' ;
print STDIN "anc";
+print <STDOUT>;
+print <STDERR>;
+open(FOO, ">&STDOUT") and print <FOO>;
+print getc(STDERR);
+print getc(FOO);
+read(FOO,$_,1);
EXPECT
Filehandle main::STDIN opened only for input at - line 3.
+Filehandle main::STDOUT opened only for output at - line 4.
+Filehandle main::STDERR opened only for output at - line 5.
+Filehandle main::FOO opened only for output at - line 6.
+Filehandle main::STDERR opened only for output at - line 7.
+Filehandle main::FOO opened only for output at - line 8.
+Filehandle main::FOO opened only for output at - line 9.
########
# pp_hot.c
use warning 'closed' ;
use warning 'closed' ;
close STDIN ; $a = <STDIN> ;
EXPECT
-Read on closed filehandle <STDIN> at - line 3.
+Read on closed filehandle main::STDIN at - line 3.
########
# pp_hot.c
use warning 'recursion' ;
untie attempted while %d inner references still exist
sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
- Filehandle only opened for input
+ Filehandle %s opened only for input
format STDIN =
.
write STDIN;
- Write on closed filehandle
+ Write on closed filehandle %s
format STDIN =
.
close STDIN;
.
write STDIN;
EXPECT
-Filehandle only opened for input at - line 5.
+Filehandle main::STDIN opened only for input at - line 5.
########
# pp_sys.c
use warning 'closed' ;
close STDIN;
write STDIN;
EXPECT
-Write on closed filehandle at - line 6.
+Write on closed filehandle main::STDIN at - line 6.
########
# pp_sys.c
use warning 'io' ;
projects / p5sagit/p5-mst-13.2.git / commitdiff