regexec.c: S_find_byclass(): utf8ness in switch()

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index ba934ff..d6cd41e 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -236,7 +236,7 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 PerlIO *
 PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
-#if defined(PERL_MICRO) || defined(__SYMBIAN32__)
+#if defined(PERL_MICRO)
     return NULL;
 #elif defined(PERL_IMPLICIT_SYS)
     return PerlSIO_fdupopen(f);
@@ -1490,7 +1490,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
             int imode, int perm, PerlIO *f, int narg, SV **args)
 {
     if (!f && narg == 1 && *args == &PL_sv_undef) {
-       if ((f = PerlIO_tmpfile())) {
+        imode = PerlIOUnix_oflags(mode);
+
+       if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) {
            if (!layers || !*layers)
                layers = Perl_PerlIO_context_layers(aTHX_ mode);
            if (layers && *layers)
@@ -2254,7 +2256,6 @@ static void
 S_more_refcounted_fds(pTHX_ const int new_fd)
   PERL_TSA_REQUIRES(PL_perlio_mutex)
 {
-    dVAR;
     const int old_max = PL_perlio_fd_refcnt_size;
     const int new_max = 16 + (new_fd & ~15);
     int *new_array;
@@ -2304,7 +2305,6 @@ PerlIOUnix_refcnt_inc(int fd)
 {
     dTHX;
     if (fd >= 0) {
-       dVAR;
 
        MUTEX_LOCK(&PL_perlio_mutex);
        if (fd >= PL_perlio_fd_refcnt_size)
@@ -2334,7 +2334,6 @@ PerlIOUnix_refcnt_dec(int fd)
 #ifdef DEBUGGING
         dTHX;
 #else
-       dVAR;
 #endif
        MUTEX_LOCK(&PL_perlio_mutex);
        if (fd >= PL_perlio_fd_refcnt_size) {
@@ -2363,7 +2362,6 @@ PerlIOUnix_refcnt(int fd)
     dTHX;
     int cnt = 0;
     if (fd >= 0) {
-       dVAR;
        MUTEX_LOCK(&PL_perlio_mutex);
        if (fd >= PL_perlio_fd_refcnt_size) {
            /* diag_listed_as: refcnt: fd %d%s */
@@ -2414,7 +2412,6 @@ PerlIO_cleanup(pTHX)
 
 void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */
 {
-    dVAR;
 #if 0
 /* XXX we can't rely on an interpreter being present at this late stage,
    XXX so we can't use a function like PerlLIO_write that relies on one
@@ -2742,10 +2739,6 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
        return -1;
     fd = PerlIOSelf(f, PerlIOUnix)->fd;
-#ifdef PERLIO_STD_SPECIAL
-    if (fd == 0)
-        return PERLIO_STD_IN(fd, vbuf, count);
-#endif
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) ||
          PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
        return 0;
@@ -2779,10 +2772,6 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
        return -1;
     fd = PerlIOSelf(f, PerlIOUnix)->fd;
-#ifdef PERLIO_STD_SPECIAL
-    if (fd == 1 || fd == 2)
-        return PERLIO_STD_OUT(fd, vbuf, count);
-#endif
     while (1) {
        const SSize_t len = PerlLIO_write(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
@@ -2816,6 +2805,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
     if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
+        code = PerlIOBase_close(aTHX_ f);
        if (PerlIOUnix_refcnt_dec(fd) > 0) {
            PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
            return 0;
@@ -3231,13 +3221,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->_file = -1;
     return 1;
 #  elif defined(WIN32)
-#    if defined(UNDER_CE)
-    /* WIN_CE does not have access to FILE internals, it hardly has FILE
-       structure at all
-     */
-#    else
     PERLIO_FILE_file(f) = -1;
-#    endif
     return 1;
 #  else
 #if 0
@@ -3266,7 +3250,6 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        int dupfd = -1;
        dSAVEDERRNO;
 #ifdef USE_ITHREADS
-       dVAR;
 #endif
 #ifdef SOCKS5_VERSION_NAME
        /* Socks lib overrides close() but stdio isn't linked to
@@ -4825,7 +4808,7 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f)
        PerlIO_pop(aTHX_ f);
 #endif
     }
-    return 0;
+    return PerlIOBase_binmode(aTHX_ f);
 }
 
 PERLIO_FUNCS_DECL(PerlIO_crlf) = {
@@ -5049,44 +5032,60 @@ PerlIO_stdoutf(const char *fmt, ...)
 PerlIO *
 PerlIO_tmpfile(void)
 {
+    return PerlIO_tmpfile_flags(0);
+}
+
+#define MKOSTEMP_MODES ( O_RDWR | O_CREAT | O_EXCL )
+#define MKOSTEMP_MODE_MASK ( O_ACCMODE | O_CREAT | O_EXCL | O_TRUNC )
+
+PerlIO *
+PerlIO_tmpfile_flags(int imode)
+{
 #ifndef WIN32
      dTHX;
 #endif
      PerlIO *f = NULL;
 #ifdef WIN32
-     const int fd = win32_tmpfd();
+     const int fd = win32_tmpfd_mode(imode);
      if (fd >= 0)
          f = PerlIO_fdopen(fd, "w+b");
-#elif ! defined(VMS) && ! defined(OS2)
+#elif ! defined(OS2)
      int fd = -1;
      char tempname[] = "/tmp/PerlIO_XXXXXX";
      const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
      SV * sv = NULL;
      int old_umask = umask(0177);
+     imode &= ~MKOSTEMP_MODE_MASK;
      if (tmpdir && *tmpdir) {
         /* if TMPDIR is set and not empty, we try that first */
         sv = newSVpv(tmpdir, 0);
         sv_catpv(sv, tempname + 4);
-        fd = Perl_my_mkstemp_cloexec(SvPVX(sv));
+        fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE);
      }
      if (fd < 0) {
         SvREFCNT_dec(sv);
         sv = NULL;
         /* else we try /tmp */
-        fd = Perl_my_mkstemp_cloexec(tempname);
+        fd = Perl_my_mkostemp_cloexec(tempname, imode | O_VMS_DELETEONCLOSE);
      }
      if (fd < 0) {
          /* Try cwd */
          sv = newSVpvs(".");
          sv_catpv(sv, tempname + 4);
-         fd = Perl_my_mkstemp_cloexec(SvPVX(sv));
+         fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE);
      }
      umask(old_umask);
      if (fd >= 0) {
-         f = PerlIO_fdopen(fd, "w+");
+         /* fdopen() with a numeric mode */
+         char mode[8];
+         int writing = 1;
+         (void)PerlIO_intmode2str(imode | MKOSTEMP_MODES, mode, &writing);
+         f = PerlIO_fdopen(fd, mode);
          if (f)
               PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+#   ifndef VMS
          PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname);
+#   endif
      }
      SvREFCNT_dec(sv);
 #else  /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */