X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e1ec3a884f8d8c64eb7e391b2a363f47cbeed570..0298d7b92741692bcf2e34c418a564332bb034e6:/doio.c?ds=sidebyside diff --git a/doio.c b/doio.c index c8bc22d..e018964 100644 --- a/doio.c +++ b/doio.c @@ -71,6 +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; return do_openn(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, &svs, 1); } @@ -80,6 +81,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num_svs) { + dVAR; register IO *io = GvIOn(gv); PerlIO *saveifp = Nullfp; PerlIO *saveofp = Nullfp; @@ -156,7 +158,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, |O_TRUNC #endif ; - int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; + const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; int ismodifying; if (num_svs != 0) { @@ -218,7 +220,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (num_svs) { /* New style explicit name, type is just mode and layer info */ - STRLEN l = 0; #ifdef USE_STDIO if (SvROK(*svp) && !strchr(name,'&')) { if (ckWARN(WARN_IO)) @@ -228,9 +229,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, goto say_false; } #endif /* USE_STDIO */ - name = SvOK(*svp) ? SvPV(*svp, l) : ""; - len = (I32)l; - name = savepvn(name, len); + name = SvOK(*svp) ? savesvpv (*svp) : savepvn ("", 0); SAVEFREEPV(name); } else { @@ -676,10 +675,10 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, sv = *av_fetch(PL_fdpid,fd,TRUE); (void)SvUPGRADE(sv, SVt_IV); pid = SvIVX(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); sv = *av_fetch(PL_fdpid,savefd,TRUE); (void)SvUPGRADE(sv, SVt_IV); - SvIVX(sv) = pid; + SvIV_set(sv, pid); UNLOCK_FDPID_MUTEX; } #endif @@ -823,7 +822,7 @@ Perl_nextargv(pTHX_ register GV *gv) sv_catpv(sv,PL_inplace); } #ifndef FLEXFILENAMES - if ((PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0 + if ((PerlLIO_stat(SvPVX_const(sv),&PL_statbuf) >= 0 && PL_statbuf.st_dev == filedev && PL_statbuf.st_ino == fileino) #ifdef DJGPP @@ -841,7 +840,7 @@ Perl_nextargv(pTHX_ register GV *gv) #endif #ifdef HAS_RENAME #if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC) - if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) { + if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %"SVf": %s, skipping file", @@ -851,13 +850,13 @@ Perl_nextargv(pTHX_ register GV *gv) } #else do_close(gv,FALSE); - (void)PerlLIO_unlink(SvPVX(sv)); - (void)PerlLIO_rename(PL_oldname,SvPVX(sv)); + (void)PerlLIO_unlink(SvPVX_const(sv)); + (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv)); do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp); #endif /* DOSISH */ #else - (void)UNLINK(SvPVX(sv)); - if (link(PL_oldname,SvPVX(sv)) < 0) { + (void)UNLINK(SvPVX_const(sv)); + if (link(PL_oldname,SvPVX_const(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %"SVf": %s, skipping file", @@ -927,7 +926,7 @@ Perl_nextargv(pTHX_ register GV *gv) } else { if (ckWARN_d(WARN_INPLACE)) { - int eno = errno; + const int eno = errno; if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0 && !S_ISREG(PL_statbuf.st_mode)) { @@ -1041,14 +1040,13 @@ bool Perl_io_close(pTHX_ IO *io, bool not_implicit) { bool retval = FALSE; - int status; if (IoIFP(io)) { if (IoTYPE(io) == IoTYPE_PIPE) { - status = PerlProc_pclose(IoIFP(io)); + const int status = PerlProc_pclose(IoIFP(io)); if (not_implicit) { STATUS_NATIVE_SET(status); - retval = (STATUS_POSIX == 0); + retval = (STATUS_UNIX == 0); } else { retval = (status != -1); @@ -1178,7 +1176,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp) int mode = O_BINARY; if (discp) { STRLEN len; - char *s = SvPV(discp,len); + const char *s = SvPV(discp,len); while (*s) { if (*s == ':') { switch (s[1]) { @@ -1211,7 +1209,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp) --len; } else { - char *end; + const char *end; fail_discipline: end = strchr(s+1, ':'); if (!end) @@ -1242,14 +1240,14 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) return PerlIO_binmode(aTHX_ fp, iotype, mode, name); } -#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) +#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) +I32 +my_chsize(int fd, Off_t length) +{ +#ifdef F_FREESP /* code courtesy of William Kucharski */ #define HAS_CHSIZE -I32 my_chsize(fd, length) -I32 fd; /* file descriptor */ -Off_t length; /* length to set file to */ -{ struct flock fl; Stat_t filebuf; @@ -1288,10 +1286,13 @@ Off_t length; /* length to set file to */ return -1; } - return 0; -} +#else + Perl_croak_nocontext("truncate not implemented"); #endif /* F_FREESP */ + return -1; +} +#endif /* !HAS_TRUNCATE && !HAS_CHSIZE */ bool Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) @@ -1372,7 +1373,7 @@ Perl_my_stat(pTHX) io = GvIO(gv); if (io && IoIFP(io)) { PL_statgv = gv; - sv_setpv(PL_statname,""); + sv_setpvn(PL_statname,"", 0); PL_laststype = OP_STAT; return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); } @@ -1382,7 +1383,7 @@ Perl_my_stat(pTHX) if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); PL_statgv = Nullgv; - sv_setpv(PL_statname,""); + sv_setpvn(PL_statname,"", 0); return (PL_laststatval = -1); } } @@ -1391,7 +1392,7 @@ Perl_my_stat(pTHX) } else { SV* sv = POPs; - char *s; + const char *s; STRLEN len; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { @@ -1406,7 +1407,7 @@ Perl_my_stat(pTHX) s = SvPV(sv, len); PL_statgv = Nullgv; sv_setpvn(PL_statname, s, len); - s = SvPVX(PL_statname); /* s now NUL-terminated */ + s = SvPVX_const(PL_statname); /* s now NUL-terminated */ PL_laststype = OP_STAT; PL_laststatval = PerlLIO_stat(s, &PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) @@ -1415,7 +1416,7 @@ Perl_my_stat(pTHX) } } -static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; +static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; I32 Perl_my_lstat(pTHX) @@ -1449,6 +1450,7 @@ Perl_my_lstat(pTHX) GvENAME((GV*) SvRV(sv))); return (PL_laststatval = -1); } + /* XXX Do really need to be calling SvPV() all these times? */ sv_setpv(PL_statname,SvPV(sv, n_a)); PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) @@ -1468,7 +1470,8 @@ bool Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, int fd, int do_report) { -#ifdef MACOS_TRADITIONAL + dVAR; +#if defined(MACOS_TRADITIONAL) || defined(SYMBIAN) Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else register char **a; @@ -1524,7 +1527,7 @@ Perl_do_execfree(pTHX) } } -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL) bool Perl_do_exec(pTHX_ char *cmd) @@ -1535,6 +1538,7 @@ Perl_do_exec(pTHX_ char *cmd) bool Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) { + dVAR; register char **a; register char *s; @@ -1608,7 +1612,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) && s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) && (!s[3] || isSPACE(s[3]))) { - char *t = s + 3; + const char *t = s + 3; while (*t && isSPACE(*t)) ++t; @@ -1646,12 +1650,11 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) goto doshell; } { - int e = errno; - if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno)); if (do_report) { + int e = errno; PerlLIO_write(fd, (void*)&e, sizeof(int)); PerlLIO_close(fd); } @@ -1667,7 +1670,6 @@ I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { register I32 val; - register I32 val2; register I32 tot = 0; const char *what; char *s; @@ -1698,7 +1700,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, n_a); + const char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chmod(name, val)) tot--; @@ -1710,12 +1712,13 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) what = "chown"; APPLY_TAINT_PROPER(); if (sp - mark > 2) { + register I32 val2; val = SvIVx(*++mark); val2 = SvIVx(*++mark); APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, n_a); + const char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chown(name, val, val2)) tot--; @@ -1828,16 +1831,17 @@ nothing in the core. if (sp - mark > 2) { #if defined(I_UTIME) || defined(VMS) struct utimbuf utbuf; + struct utimbuf *utbufp = &utbuf; #else struct { Time_t actime; Time_t modtime; } utbuf; + void *utbufp = &utbuf; #endif SV* accessed = *++mark; SV* modified = *++mark; - void * utbufp = &utbuf; /* Be like C, and if both times are undefined, let the C * library figure out what to do. This usually means @@ -1855,12 +1859,13 @@ nothing in the core. utbuf.modtime = (Time_t)SvIVx(modified); /* time modified */ #endif } - APPLY_TAINT_PROPER(); + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, n_a); + STRLEN n_a; + const char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); - if (PerlLIO_utime(name, utbufp)) + if (PerlLIO_utime(name, utbufp)) tot--; } } @@ -1877,7 +1882,7 @@ nothing in the core. /* Do the permissions allow some operation? Assumes statcache already set. */ #ifndef VMS /* VMS' cando is in vms.c */ bool -Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register Stat_t *statbufp) +Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register const Stat_t *statbufp) /* Note: we use `effective' both for uids and gids. * Here we are betting on Uid_t being equal or wider than Gid_t. */ { @@ -1962,12 +1967,11 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { - key_t key; - I32 n, flags; + key_t key = (key_t)SvNVx(*++mark); + const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); + const I32 flags = SvIVx(*++mark); + (void)sp; - key = (key_t)SvNVx(*++mark); - n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); - flags = SvIVx(*++mark); SETERRNO(0,0); switch (optype) { @@ -1996,12 +2000,13 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { SV *astr; char *a; - I32 id, n, cmd, infosize, getinfo; + I32 infosize, getinfo; I32 ret = -1; + const I32 id = SvIVx(*++mark); + const I32 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; + const I32 cmd = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); - n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; - cmd = SvIVx(*++mark); astr = *++mark; infosize = 0; getinfo = (cmd == IPC_STAT); @@ -2120,10 +2125,11 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) #ifdef HAS_MSG SV *mstr; char *mbuf; - I32 id, msize, flags; + I32 msize, flags; STRLEN len; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; flags = SvIVx(*++mark); mbuf = SvPV(mstr, len); @@ -2143,10 +2149,11 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) SV *mstr; char *mbuf; long mtype; - I32 id, msize, flags, ret; + I32 msize, flags, ret; STRLEN len; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; /* suppress warning when reading into undef var --jhi */ if (! SvOK(mstr)) @@ -2179,10 +2186,10 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) #ifdef HAS_SEM SV *opstr; char *opbuf; - I32 id; STRLEN opsize; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); opstr = *++mark; opbuf = SvPV(opstr, opsize); if (opsize < 3 * SHORTSIZE @@ -2193,7 +2200,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) SETERRNO(0,0); /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ { - int nsops = opsize / (3 * sizeof (short)); + const int nsops = opsize / (3 * sizeof (short)); int i = nsops; short *ops = (short *) opbuf; short *o = ops; @@ -2231,12 +2238,13 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_SHM SV *mstr; - char *mbuf, *shm; - I32 id, mpos, msize; + char *shm; + I32 mpos, msize; STRLEN len; struct shmid_ds shmds; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; mpos = SvIVx(*++mark); msize = SvIVx(*++mark); @@ -2251,6 +2259,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) if (shm == (char *)-1) /* I hate System V IPC, I really do */ return -1; if (optype == OP_SHMREAD) { + const char *mbuf; /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ if (! SvOK(mstr)) sv_setpvn(mstr, "", 0); @@ -2269,7 +2278,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) else { I32 n; - mbuf = SvPV(mstr, len); + const char *mbuf = SvPV(mstr, len); if ((n = len) > msize) n = msize; Copy(mbuf, shm + mpos, n, char); @@ -2300,6 +2309,7 @@ Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up. PerlIO * Perl_start_glob (pTHX_ SV *tmpglob, IO *io) { + dVAR; SV *tmpcmd = NEWSV(55, 0); PerlIO *fp; ENTER; @@ -2346,7 +2356,7 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) } if ((tmpfp = PerlIO_tmpfile()) != NULL) { Stat_t st; - if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode)) + if (!PerlLIO_stat(SvPVX_const(tmpglob),&st) && S_ISDIR(st.st_mode)) ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL); else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); @@ -2433,3 +2443,13 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) LEAVE; return fp; } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */