X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=f1eb1b94747ba257b3064df54711a1b82b8dd0ce;hb=0d55c8f7c05ceae7db13bb3863932232a57c2a7b;hp=d1dacdd3c87b39f9647f13aca11d6eb9ebd2e6eb;hpb=93189314521460c01625b05f7cfa81ac855affa9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index d1dacdd..f1eb1b9 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -457,7 +457,7 @@ PP(pp_die) } else { tmpsv = TOPs; - tmps = (SvROK(tmpsv) && PL_in_eval) ? Nullch : SvPV(tmpsv, len); + tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len); } if (!tmps || !len) { SV *error = ERRSV; @@ -608,8 +608,8 @@ PP(pp_pipe_op) if (PerlProc_pipe(fd) < 0) goto badexit; - IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); - IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE); + IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE); IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; @@ -734,6 +734,7 @@ PP(pp_binmode) if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) { if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } @@ -1177,6 +1178,7 @@ PP(pp_getc) if (ckWARN2(WARN_UNOPENED,WARN_CLOSED) && (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))) report_evil_fh(gv, io, PL_op->op_type); + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } TAINT; @@ -1206,8 +1208,6 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) { register PERL_CONTEXT *cx; I32 gimme = GIMME_V; - AV* padlist = CvPADLIST(cv); - SV** svp = AvARRAY(padlist); ENTER; SAVETMPS; @@ -1215,8 +1215,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) push_return(retop); PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp); PUSHFORMAT(cx); - SAVEVPTR(PL_curpad); - PL_curpad = AvARRAY((AV*)svp[1]); + PAD_SET_CUR(CvPADLIST(cv), 1); setdefout(gv); /* locally select filehandle so $% et al work */ return CvSTART(cv); @@ -1574,8 +1573,12 @@ PP(pp_sysread) else offset = 0; io = GvIO(gv); - if (!io || !IoIFP(io)) + if (!io || !IoIFP(io)) { + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); + SETERRNO(EBADF,RMS_IFI); goto say_undef; + } if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { buffer = SvPVutf8_force(bufsv, blen); /* UTF8 may not have been set if they are all low bytes */ @@ -1816,6 +1819,7 @@ PP(pp_send) retval = -1; if (ckWARN(WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); + SETERRNO(EBADF,RMS_IFI); goto say_undef; } @@ -2277,8 +2281,8 @@ PP(pp_socket) fd = PerlSock_socket(domain, type, protocol); if (fd < 0) RETPUSHUNDEF; - IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */ - IoOFP(io) = PerlIO_fdopen(fd, "w"); + IoIFP(io) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE); /* stdio gets confused about sockets */ + IoOFP(io) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE); IoTYPE(io) = IoTYPE_SOCKET; if (!IoIFP(io) || !IoOFP(io)) { if (IoIFP(io)) PerlIO_close(IoIFP(io)); @@ -2339,11 +2343,11 @@ PP(pp_sockpair) TAINT_PROPER("socketpair"); if (PerlSock_socketpair(domain, type, protocol, fd) < 0) RETPUSHUNDEF; - IoIFP(io1) = PerlIO_fdopen(fd[0], "r"); - IoOFP(io1) = PerlIO_fdopen(fd[0], "w"); + IoIFP(io1) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE); + IoOFP(io1) = PerlIO_fdopen(fd[0], "w"PIPESOCK_MODE); IoTYPE(io1) = IoTYPE_SOCKET; - IoIFP(io2) = PerlIO_fdopen(fd[1], "r"); - IoOFP(io2) = PerlIO_fdopen(fd[1], "w"); + IoIFP(io2) = PerlIO_fdopen(fd[1], "r"PIPESOCK_MODE); + IoOFP(io2) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE); IoTYPE(io2) = IoTYPE_SOCKET; if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) { if (IoIFP(io1)) PerlIO_close(IoIFP(io1)); @@ -2511,12 +2515,12 @@ PP(pp_accept) goto badexit; if (IoIFP(nstio)) do_close(ngv, FALSE); - IoIFP(nstio) = PerlIO_fdopen(fd, "r"); + IoIFP(nstio) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE); /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit fclose of IoOFP's FILE * - and hence leak memory. Special treatment of _this_ case of IoIFP != IoOFP seems wrong. */ - IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w"); + IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w"PIPESOCK_MODE); IoTYPE(nstio) = IoTYPE_SOCKET; if (!IoIFP(nstio) || !IoOFP(nstio)) { if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio)); @@ -3714,7 +3718,7 @@ PP(pp_mkdir) * -d, chdir(), chmod(), chown(), chroot(), fcntl()?, * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */ if (len > 1 && tmps[len-1] == '/') { - while (tmps[len] == '/' && len > 1) + while (tmps[len-1] == '/' && len > 1) len--; tmps = savepvn(tmps, len); copy = TRUE;