X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=ef16b07906f19a2373d2c8d9cc66d37de3f3929e;hb=b2a156bd8e464af88881c77344280160fd844dcf;hp=25756ab5dd94de7c982234ede38f6d73fb981169;hpb=5228a96c60a47c008c307f4fa3bf942383d38423;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 25756ab..ef16b07 100644 --- a/doio.c +++ b/doio.c @@ -258,17 +258,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } mode[0] = 'w'; writing = 1; -#ifdef HAS_STRLCAT if (out_raw) - strlcat(mode, "b", PERL_MODE_MAX - 1); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (out_crlf) - strlcat(mode, "t", PERL_MODE_MAX - 1); -#else - if (out_raw) - strcat(mode, "b"); - else if (out_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (num_svs > 1) { fp = PerlProc_popen_list(mode, num_svs, svp); } @@ -296,17 +289,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } writing = 1; -#ifdef HAS_STRLCAT if (out_raw) - strlcat(mode, "b", PERL_MODE_MAX - 1); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (out_crlf) - strlcat(mode, "t", PERL_MODE_MAX - 1); -#else - if (out_raw) - strcat(mode, "b"); - else if (out_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*type == '&') { duplicity: dodup = PERLIO_DUP_FD; @@ -429,17 +415,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, type++; } while (isSPACE(*type)); mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX - 1); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX - 1); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*type == '&') { goto duplicity; } @@ -490,17 +469,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, TAINT_PROPER("piped open"); mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX - 1); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX - 1); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (num_svs > 1) { fp = PerlProc_popen_list(mode,num_svs,svp); @@ -528,17 +500,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, ; mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX - 1); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX - 1); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*name == '-' && name[1] == '\0') { fp = PerlIO_stdin(); @@ -1311,6 +1276,7 @@ Perl_my_stat(pTHX) if (gv == PL_defgv) return PL_laststatval; io = GvIO(gv); + do_fstat_have_io: PL_laststype = OP_STAT; PL_statgv = gv; sv_setpvn(PL_statname, "", 0); @@ -1321,7 +1287,8 @@ Perl_my_stat(pTHX) #ifdef HAS_DIRFD return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache)); #else - DIE(aTHX_ PL_no_func, "dirfd"); + Perl_die(aTHX_ PL_no_func, "dirfd"); + NORETURN_FUNCTION_END; #endif } else { if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) @@ -1350,6 +1317,11 @@ Perl_my_stat(pTHX) gv = (GV*)SvRV(sv); goto do_fstat; } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + io = (IO*)SvRV(sv); + gv = NULL; + goto do_fstat_have_io; + } s = SvPV_const(sv, len); PL_statgv = NULL; @@ -1361,6 +1333,8 @@ Perl_my_stat(pTHX) Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); return PL_laststatval; } + /* Should we warn/croak here? Or do something smart/useful? */ + return (PL_laststatval = -1); } @@ -1478,10 +1452,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) char *cmd; /* Make a copy so we can change it */ - const int cmdlen = strlen(incmd); - Newx(cmd, cmdlen+1, char); - strncpy(cmd, incmd, cmdlen); - cmd[cmdlen] = 0; + const Size_t cmdlen = strlen(incmd) + 1; + Newx(cmd, cmdlen, char); + my_strlcpy(cmd, incmd, cmdlen); while (*cmd && isSPACE(*cmd)) cmd++; @@ -1493,19 +1466,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) char flags[PERL_FLAGS_MAX]; if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) { -#ifdef HAS_STRLCPY - strlcpy(flags, "-c", PERL_FLAGS_MAX); -#else - strcpy(flags,"-c"); -#endif + my_strlcpy(flags, "-c", PERL_FLAGS_MAX); s = cmd+PL_cshlen+3; if (*s == 'f') { s++; -#ifdef HAS_STRLCPY - strlcat(flags, "f", PERL_FLAGS_MAX - 2); -#else - strcat(flags,"f"); -#endif + my_strlcat(flags, "f", PERL_FLAGS_MAX - 2); } if (*s == ' ') s++; @@ -1519,7 +1484,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (s[-1] == '\'') { *--s = '\0'; PERL_FPU_PRE_EXEC - PerlProc_execl(PL_cshname, "csh", flags, ncmd, NULL); + PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); PERL_FPU_POST_EXEC *s = '\''; S_exec_failed(aTHX_ PL_cshname, fd, do_report); @@ -1568,7 +1533,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } doshell: PERL_FPU_PRE_EXEC - PerlProc_execl(PL_sh_path, "sh", "-c", cmd, NULL); + PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); PERL_FPU_POST_EXEC S_exec_failed(aTHX_ PL_sh_path, fd, do_report); Safefree(cmd); @@ -2289,7 +2254,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) SETERRNO(0,0); if (shmctl(id, IPC_STAT, &shmds) == -1) return -1; - if (mpos < 0 || msize < 0 || (size_t)mpos + msize > shmds.shm_segsz) { + if (mpos < 0 || msize < 0 + || (size_t)mpos + msize > (size_t)shmds.shm_segsz) { SETERRNO(EFAULT,SS_ACCVIO); /* can't do as caller requested */ return -1; } @@ -2317,7 +2283,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) STRLEN len; const char *mbuf = SvPV_const(mstr, len); - const I32 n = (len > msize) ? msize : len; + const I32 n = ((I32)len > msize) ? msize : (I32)len; Copy(mbuf, shm + mpos, n, char); if (n < msize) memzero(shm + mpos + n, msize - n);