embed.fnc: Mark doing_taint as Core only

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 994dc70..439f2d0 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -191,7 +191,6 @@ Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd)
      * to extend it, so for the time being this just isn't available on
      * PERL_IMPLICIT_SYS builds.
      */
-    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
         PL_strategy_dup,
        fcntl(oldfd, F_DUPFD_CLOEXEC, 0),
@@ -210,7 +209,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
      * to extend it, so for the time being this just isn't available on
      * PERL_IMPLICIT_SYS builds.
      */
-    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
         PL_strategy_dup2,
        dup3(oldfd, newfd, O_CLOEXEC),
@@ -223,7 +221,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
 int
 Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
 {
-    dVAR;
     PERL_ARGS_ASSERT_PERLLIO_OPEN_CLOEXEC;
 #if defined(O_CLOEXEC)
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
@@ -238,7 +235,6 @@ Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
 int
 Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
 {
-    dVAR;
     PERL_ARGS_ASSERT_PERLLIO_OPEN3_CLOEXEC;
 #if defined(O_CLOEXEC)
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
@@ -253,7 +249,6 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
 int
 Perl_my_mkstemp_cloexec(char *templte)
 {
-    dVAR;
     PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC;
 #if defined(O_CLOEXEC)
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
@@ -268,7 +263,6 @@ Perl_my_mkstemp_cloexec(char *templte)
 int
 Perl_my_mkostemp_cloexec(char *templte, int flags)
 {
-    dVAR;
     PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC;
 #if defined(O_CLOEXEC)
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
@@ -284,7 +278,6 @@ Perl_my_mkostemp_cloexec(char *templte, int flags)
 int
 Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
 {
-    dVAR;
     PERL_ARGS_ASSERT_PERLPROC_PIPE_CLOEXEC;
     /*
      * struct IPerlProc doesn't cover pipe2(), and there's no clear way
@@ -307,7 +300,6 @@ int
 Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol)
 {
 #  if defined(SOCK_CLOEXEC)
-    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
         PL_strategy_socket,
        PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol),
@@ -328,7 +320,6 @@ Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr,
      * way to extend it, so for the time being this just isn't available
      * on PERL_IMPLICIT_SYS builds.
      */
-    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
         PL_strategy_accept,
        accept4(listenfd, addr, addrlen, SOCK_CLOEXEC),
@@ -347,7 +338,6 @@ int
 Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol,
     int *pairfd)
 {
-    dVAR;
     PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC;
 #  ifdef SOCK_CLOEXEC
     DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_socketpair, pairfd,
@@ -1322,7 +1312,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
     PL_filemode = 0;
     if (!GvAV(gv))
        return NULL;
-    while (av_tindex(GvAV(gv)) >= 0) {
+    while (av_count(GvAV(gv)) > 0) {
        STRLEN oldlen;
         SV *const sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
@@ -2297,7 +2287,6 @@ bool
 Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
               int fd, int do_report)
 {
-    dVAR;
     PERL_ARGS_ASSERT_DO_AEXEC5;
 #if defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
@@ -2348,7 +2337,6 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
 bool
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
-    dVAR;
     const char **argv, **a;
     char *s;
     char *buf;
@@ -3011,13 +2999,17 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     {
        if (getinfo)
        {
-           SvPV_force_nolen(astr);
+            /* we're not using the value here, so don't SvPVanything */
+            SvUPGRADE(astr, SVt_PV);
+            SvGETMAGIC(astr);
+            if (SvTHINKFIRST(astr))
+                sv_force_normal_flags(astr, 0);
            a = SvGROW(astr, infosize+1);
        }
        else
        {
            STRLEN len;
-           a = SvPV(astr, len);
+           a = SvPVbyte(astr, len);
            if (len != infosize)
                Perl_croak(aTHX_ "Bad arg length for %s, is %lu, should be %ld",
                      PL_op_desc[optype],
@@ -3027,8 +3019,18 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     }
     else
     {
-       const IV i = SvIV(astr);
-       a = INT2PTR(char *,i);          /* ouch */
+        /* We historically treat this as a pointer if we don't otherwise recognize
+           the op, but for many ops the value is simply ignored anyway, so
+           don't warn on undef.
+        */
+        SvGETMAGIC(astr);
+        if (SvOK(astr)) {
+            const IV i = SvIV_nomg(astr);
+            a = INT2PTR(char *,i);             /* ouch */
+        }
+        else {
+            a = NULL;
+        }
     }
     SETERRNO(0,0);
     switch (optype)
@@ -3070,6 +3072,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     if (getinfo && ret >= 0) {
        SvCUR_set(astr, infosize);
        *SvEND(astr) = '\0';
+        SvPOK_only(astr);
        SvSETMAGIC(astr);
     }
     return ret;
@@ -3083,7 +3086,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     const I32 id = SvIVx(*++mark);
     SV * const mstr = *++mark;
     const I32 flags = SvIVx(*++mark);
-    const char * const mbuf = SvPV_const(mstr, len);
+    const char * const mbuf = SvPVbyte(mstr, len);
     const I32 msize = len - sizeof(long);
 
     PERL_ARGS_ASSERT_DO_MSGSND;
@@ -3138,6 +3141,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     }
     if (ret >= 0) {
        SvCUR_set(mstr, sizeof(long)+ret);
+        SvPOK_only(mstr);
        *SvEND(mstr) = '\0';
        /* who knows who has been playing with this message? */
        SvTAINTED_on(mstr);
@@ -3159,7 +3163,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     STRLEN opsize;
     const I32 id = SvIVx(*++mark);
     SV * const opstr = *++mark;
-    const char * const opbuf = SvPV_const(opstr, opsize);
+    const char * const opbuf = SvPVbyte(opstr, opsize);
 
     PERL_ARGS_ASSERT_DO_SEMOP;
     PERL_UNUSED_ARG(sp);
@@ -3247,7 +3251,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     else {
        STRLEN len;
 
-       const char *mbuf = SvPV_const(mstr, len);
+       const char *mbuf = SvPVbyte(mstr, len);
        const I32 n = ((I32)len > msize) ? msize : (I32)len;
        Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
@@ -3264,8 +3268,6 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #endif /* SYSV IPC */
 
 /*
-=head1 IO Functions
-
 =for apidoc start_glob
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside