X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8af710ebc7fee929ae47793d5a0cce5362af52db..935647290357b277:/doio.c diff --git a/doio.c b/doio.c index 06f2d3d..7cb0096 100644 --- a/doio.c +++ b/doio.c @@ -929,8 +929,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) io = GvIO(gv); if (!io) { /* never opened */ if (not_implicit) { - if (ckWARN(WARN_UNOPENED)) /* no check for closed here */ - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); } return FALSE; @@ -996,8 +995,8 @@ Perl_do_eof(pTHX_ GV *gv) if (!io) return TRUE; - else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO)) - report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); + else if (IoTYPE(io) == IoTYPE_WRONLY) + report_wrongway_fh(gv, '>'); while (IoIFP(io)) { if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */ @@ -1035,20 +1034,19 @@ Off_t Perl_do_tell(pTHX_ GV *gv) { dVAR; - register IO *io = NULL; + IO *const io = GvIO(gv); register PerlIO *fp; PERL_ARGS_ASSERT_DO_TELL; - if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { + if (io && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH if (PerlIO_eof(fp)) (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif return PerlIO_tell(fp); } - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; } @@ -1057,18 +1055,17 @@ bool Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { dVAR; - register IO *io = NULL; + IO *const io = GvIO(gv); register PerlIO *fp; - if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { + if (io && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH if (PerlIO_eof(fp)) (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif return PerlIO_seek(fp, pos, whence) >= 0; } - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return FALSE; } @@ -1077,15 +1074,14 @@ Off_t Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { dVAR; - register IO *io = NULL; + IO *const io = GvIO(gv); register PerlIO *fp; PERL_ARGS_ASSERT_DO_SYSSEEK; - if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) + if (io && (fp = IoIFP(io))) return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; } @@ -1228,6 +1224,9 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) tmpbuf = bytes_to_utf8((const U8*) tmps, &len); tmps = (char *) tmpbuf; } + else if (ckWARN_d(WARN_UTF8)) { + (void) check_utf8_print((const U8*) tmps, len); + } } else if (DO_UTF8(sv)) { STRLEN tmplen = len; @@ -1241,7 +1240,12 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) else { assert((char *)result == tmps); Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "Wide character in print"); + "Wide character in %s", + PL_op ? OP_DESC(PL_op) : "print" + ); + /* Could also check that isn't one of the things to avoid + * in utf8 by using check_utf8_print(), but not doing so, + * since the stream isn't a UTF8 stream */ } } /* To detect whether the process is about to overstep its @@ -1258,7 +1262,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) } I32 -Perl_my_stat(pTHX) +Perl_my_stat_flags(pTHX_ const U32 flags) { dVAR; dSP; @@ -1282,13 +1286,11 @@ Perl_my_stat(pTHX) } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); return (PL_laststatval = -1); } } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); return (PL_laststatval = -1); } } @@ -1314,7 +1316,7 @@ Perl_my_stat(pTHX) goto do_fstat_have_io; } - s = SvPV_const(sv, len); + s = SvPV_flags_const(sv, len, flags); PL_statgv = NULL; sv_setpvn(PL_statname, s, len); s = SvPVX_const(PL_statname); /* s now NUL-terminated */ @@ -1328,7 +1330,7 @@ Perl_my_stat(pTHX) I32 -Perl_my_lstat(pTHX) +Perl_my_lstat_flags(pTHX_ const U32 flags) { dVAR; static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; @@ -1361,7 +1363,7 @@ Perl_my_lstat(pTHX) GvENAME((const GV *)SvRV(sv))); return (PL_laststatval = -1); } - file = SvPV_nolen_const(sv); + file = SvPV_flags_const_nolen(sv, flags); sv_setpv(PL_statname,file); PL_laststatval = PerlLIO_lstat(file,&PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n')) @@ -1617,6 +1619,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) tot = sp - mark; while (++mark <= sp) { GV* gv; + SvGETMAGIC(*mark); if (isGV_with_GP(*mark)) { gv = MUTABLE_GV(*mark); do_fchmod: @@ -1638,7 +1641,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) goto do_fchmod; } else { - const char *name = SvPV_nolen_const(*mark); + const char *name = SvPV_nomg_const_nolen(*mark); APPLY_TAINT_PROPER(); if (PerlLIO_chmod(name, val)) tot--; @@ -1657,6 +1660,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) tot = sp - mark; while (++mark <= sp) { GV* gv; + SvGETMAGIC(*mark); if (isGV_with_GP(*mark)) { gv = MUTABLE_GV(*mark); do_fchown: @@ -1678,7 +1682,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) goto do_fchown; } else { - const char *name = SvPV_nolen_const(*mark); + const char *name = SvPV_nomg_const_nolen(*mark); APPLY_TAINT_PROPER(); if (PerlLIO_chown(name, val, val2)) tot--; @@ -1903,7 +1907,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp) /* [Comments and code from Len Reed] * MS-DOS "user" is similar to UNIX's "superuser," but can't write * to write-protected files. The execute permission bit is set - * by the Miscrosoft C library stat() function for the following: + * by the Microsoft C library stat() function for the following: * .exe files * .com files * .bat files