X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a6e20a404b42cad25eb97280fa2bcacffda64cd6..ce44635a98097a8f9f8acc0fc8393ebd5524dbdf:/doio.c diff --git a/doio.c b/doio.c index 3a0bad0..e9c40a7 100644 --- a/doio.c +++ b/doio.c @@ -71,7 +71,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num_svs) { - (void)num_svs; + PERL_UNUSED_ARG(num_svs); return do_openn(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, &svs, 1); } @@ -82,7 +82,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, I32 num_svs) { dVAR; - register IO *io = GvIOn(gv); + register IO * const io = GvIOn(gv); PerlIO *saveifp = Nullfp; PerlIO *saveofp = Nullfp; int savefd = -1; @@ -566,7 +566,10 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } if (!fp) { - if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')) + if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) + && strchr(name, '\n') + + ) Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); goto say_false; } @@ -773,7 +776,7 @@ Perl_nextargv(pTHX_ register GV *gv) STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); - sv_setsv(GvSV(gv),sv); + sv_setsv(GvSVn(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) { @@ -1079,7 +1082,7 @@ Perl_do_eof(pTHX_ GV *gv) if (!io) return TRUE; - else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY)) + else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO)) report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); while (IoIFP(io)) { @@ -1298,19 +1301,6 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) /* assuming fp is checked earlier */ if (!sv) return TRUE; - if (PL_ofmt) { - if (SvGMAGICAL(sv)) - mg_get(sv); - if (SvIOK(sv) && SvIVX(sv) != 0) { - PerlIO_printf(fp, PL_ofmt, (NV)SvIVX(sv)); - return !PerlIO_error(fp); - } - if ( (SvNOK(sv) && SvNVX(sv) != 0.0) - || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) { - PerlIO_printf(fp, PL_ofmt, SvNVX(sv)); - return !PerlIO_error(fp); - } - } switch (SvTYPE(sv)) { case SVt_NULL: if (ckWARN(WARN_UNINITIALIZED)) @@ -1431,8 +1421,8 @@ Perl_my_lstat(pTHX) return (PL_laststatval = -1); } } - else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT - && (PL_op->op_private & OPpFT_STACKED)) + else if (PL_laststype != OP_LSTAT + && (PL_op->op_private & OPpFT_STACKED) && ckWARN(WARN_IO)) Perl_croak(aTHX_ no_prev_lstat); PL_laststype = OP_LSTAT; @@ -1468,12 +1458,12 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, #if defined(MACOS_TRADITIONAL) || defined(SYMBIAN) Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else - register char **a; - const char *tmps = Nullch; - if (sp > mark) { - New(401,PL_Argv, sp - mark + 1, char*); + char **a; + const char *tmps = Nullch; + Newx(PL_Argv, sp - mark + 1, char*); a = PL_Argv; + while (++mark <= sp) { if (*mark) *a++ = (char*)SvPV_nolen_const(*mark); @@ -1510,14 +1500,10 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, void Perl_do_execfree(pTHX) { - if (PL_Argv) { - Safefree(PL_Argv); - PL_Argv = Null(char **); - } - if (PL_Cmd) { - Safefree(PL_Cmd); - PL_Cmd = Nullch; - } + Safefree(PL_Argv); + PL_Argv = Null(char **); + Safefree(PL_Cmd); + PL_Cmd = Nullch; } #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL) @@ -1622,7 +1608,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) } } - New(402,PL_Argv, (s - cmd) / 2 + 2, char*); + Newx(PL_Argv, (s - cmd) / 2 + 2, char*); PL_Cmd = savepvn(cmd, s-cmd); a = PL_Argv; for (s = PL_Cmd; *s;) { @@ -1666,7 +1652,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) register I32 tot = 0; const char *what; const char *s; - SV **oldmark = mark; + SV ** const oldmark = mark; #define APPLY_TAINT_PROPER() \ STMT_START { \ @@ -1692,10 +1678,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - const char *name = SvPV_nolen_const(*mark); - APPLY_TAINT_PROPER(); - if (PerlLIO_chmod(name, val)) - tot--; + GV* gv; + if (SvTYPE(*mark) == SVt_PVGV) { + gv = (GV*)*mark; + do_fchmod: + if (GvIO(gv) && IoIFP(GvIOp(gv))) { +#ifdef HAS_FCHMOD + APPLY_TAINT_PROPER(); + if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) + tot--; +#else + DIE(aTHX_ PL_no_func, "fchmod"); +#endif + } + else { + tot--; + } + } + else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) { + gv = (GV*)SvRV(*mark); + goto do_fchmod; + } + else { + const char *name = SvPV_nolen_const(*mark); + APPLY_TAINT_PROPER(); + if (PerlLIO_chmod(name, val)) + tot--; + } } } break; @@ -1710,10 +1719,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - const char *name = SvPV_nolen_const(*mark); - APPLY_TAINT_PROPER(); - if (PerlLIO_chown(name, val, val2)) - tot--; + GV* gv; + if (SvTYPE(*mark) == SVt_PVGV) { + gv = (GV*)*mark; + do_fchown: + if (GvIO(gv) && IoIFP(GvIOp(gv))) { +#ifdef HAS_FCHOWN + APPLY_TAINT_PROPER(); + if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + tot--; +#else + DIE(aTHX_ PL_no_func, "fchown"); +#endif + } + else { + tot--; + } + } + else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) { + gv = (GV*)SvRV(*mark); + goto do_fchown; + } + else { + const char *name = SvPV_nolen_const(*mark); + APPLY_TAINT_PROPER(); + if (PerlLIO_chown(name, val, val2)) + tot--; + } } } break; @@ -1854,7 +1886,7 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - const char *name = SvPV_nolen_const(*mark); + char *name = SvPV_nolen(*mark); APPLY_TAINT_PROPER(); if (PerlLIO_utime(name, utbufp)) tot--; @@ -1997,7 +2029,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) const I32 id = SvIVx(*++mark); const I32 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; const I32 cmd = SvIVx(*++mark); - (void)sp; + PERL_UNUSED_ARG(sp); astr = *++mark; infosize = 0; @@ -2120,7 +2152,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) I32 msize, flags; STRLEN len; const I32 id = SvIVx(*++mark); - (void)sp; + PERL_UNUSED_ARG(sp); mstr = *++mark; flags = SvIVx(*++mark); @@ -2143,7 +2175,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) long mtype; I32 msize, flags, ret; const I32 id = SvIVx(*++mark); - (void)sp; + PERL_UNUSED_ARG(sp); mstr = *++mark; /* suppress warning when reading into undef var --jhi */ @@ -2179,7 +2211,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) const char *opbuf; STRLEN opsize; const I32 id = SvIVx(*++mark); - (void)sp; + PERL_UNUSED_ARG(sp); opstr = *++mark; opbuf = SvPV_const(opstr, opsize); @@ -2198,7 +2230,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) struct sembuf *temps, *t; I32 result; - New (0, temps, nsops, struct sembuf); + Newx (temps, nsops, struct sembuf); t = temps; while (i--) { t->sem_num = *o++; @@ -2233,7 +2265,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) I32 mpos, msize; struct shmid_ds shmds; const I32 id = SvIVx(*++mark); - (void)sp; + PERL_UNUSED_ARG(sp); mstr = *++mark; mpos = SvIVx(*++mark); @@ -2314,7 +2346,8 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) #include char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'}; char vmsspec[NAM$C_MAXRSS+1]; - char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp; + char * const rstr = rslt + sizeof(unsigned short int); + char *begin, *end, *cp; $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;"); PerlIO *tmpfp; STRLEN i;