projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
allow fields in re_tests to include \x{nnn} etc
[p5sagit/p5-mst-13.2.git] / doio.c
diff --git a/doio.c b/doio.c
index f5f59a3..ef16b07 100644 (file)
--- 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();
@@ -1308,22 +1273,33 @@ Perl_my_stat(pTHX)
        EXTEND(SP,1);
        gv = cGVOP_gv;
       do_fstat:
+        if (gv == PL_defgv)
+            return PL_laststatval;
        io = GvIO(gv);
-       if (io && IoIFP(io)) {
-           PL_statgv = gv;
-           sv_setpvn(PL_statname,"", 0);
-           PL_laststype = OP_STAT;
-           return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
-       }
-       else {
-           if (gv == PL_defgv)
-               return PL_laststatval;
-           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-               report_evil_fh(gv, io, PL_op->op_type);
-           PL_statgv = NULL;
-           sv_setpvn(PL_statname,"", 0);
-           return (PL_laststatval = -1);
-       }
+        do_fstat_have_io:
+        PL_laststype = OP_STAT;
+        PL_statgv = gv;
+        sv_setpvn(PL_statname, "", 0);
+        if(io) {
+           if (IoIFP(io)) {
+               return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
+            } else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+                return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
+#else
+                Perl_die(aTHX_ PL_no_func, "dirfd");
+                NORETURN_FUNCTION_END;
+#endif
+            } else {
+                if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                    report_evil_fh(gv, io, PL_op->op_type);
+                return (PL_laststatval = -1);
+            }
+       } else {
+            if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                report_evil_fh(gv, io, PL_op->op_type);
+            return (PL_laststatval = -1);
+        }
     }
     else if (PL_op->op_private & OPpFT_STACKED) {
        return PL_laststatval;
@@ -1341,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;
@@ -1352,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);
 }
 
 
@@ -1396,6 +1379,19 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
+static void
+S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
+{
+    const int e = errno;
+    if (ckWARN(WARN_EXEC))
+       Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+                   cmd, Strerror(e));
+    if (do_report) {
+       PerlLIO_write(fd, (void*)&e, sizeof(int));
+       PerlLIO_close(fd);
+    }
+}
+
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
@@ -1428,15 +1424,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
        else
            PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               (really ? tmps : PL_Argv[0]), Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-
-           PerlLIO_write(fd, (void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
@@ -1464,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++;
@@ -1479,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++;
@@ -1505,9 +1484,10 @@ 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);
                  Safefree(cmd);
                  return FALSE;
              }
@@ -1553,8 +1533,9 @@ 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);
            return FALSE;
        }
@@ -1582,14 +1563,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            do_execfree();
            goto doshell;
        }
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               PL_Argv[0], Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-           PerlLIO_write(fd, (const void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
     }
     do_execfree();
     Safefree(cmd);
@@ -2280,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;
     }
@@ -2308,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);
Unnamed repository; edit this file to name it for gitweb.