3 files changed, 31 insertions, 5 deletions

diff --git a/perlio.c b/perlio.c
index 81ebc156ad..805959f840 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5062,7 +5062,7 @@ PerlIO_tmpfile_flags(int imode)
      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");
@@ -5073,19 +5073,19 @@ PerlIO_tmpfile_flags(int imode)
 	 /* if TMPDIR is set and not empty, we try that first */
 	 sv = newSVpv(tmpdir, 0);
 	 sv_catpv(sv, tempname + 4);
-	 fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode);
+	 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_mkostemp_cloexec(tempname, imode);
+	 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_mkostemp_cloexec(SvPVX(sv), imode);
+         fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE);
      }
      umask(old_umask);
      if (fd >= 0) {
@@ -5096,7 +5096,9 @@ PerlIO_tmpfile_flags(int imode)
          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(). */
diff --git a/util.c b/util.c
index e6863f6dfe..165d13a39e 100644
--- a/util.c
+++ b/util.c
@@ -5712,6 +5712,11 @@ S_my_mkostemp(char *templte, int flags) {
     STRLEN len = strlen(templte);
     int fd;
     int attempts = 0;
+#ifdef VMS
+    int delete_on_close = flags & O_VMS_DELETEONCLOSE;
+
+    flags &= ~O_VMS_DELETEONCLOSE;
+#endif
 
     if (len < 6 ||
         templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' ||
@@ -5725,7 +5730,15 @@ S_my_mkostemp(char *templte, int flags) {
         for (i = 1; i <= 6; ++i) {
             templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() * TEMP_FILE_CH_COUNT)];
         }
-        fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
+#ifdef VMS
+        if (delete_on_close) {
+            fd = open(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600, "fop=dlt");
+        }
+        else
+#endif
+        {
+            fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
+        }
     } while (fd == -1 && errno == EEXIST && ++attempts <= 100);
 
     return fd;
diff --git a/util.h b/util.h
index d8fa3e8396..d9df7b39c6 100644
--- a/util.h
+++ b/util.h
@@ -248,6 +248,17 @@ means arg not present, 1 is empty string/null byte */
 int mkstemp(char*);
 #endif
 
+#ifdef PERL_CORE
+#   if defined(VMS)
+/* only useful for calls to our mkostemp() emulation */
+#       define O_VMS_DELETEONCLOSE 0x40000000
+#       ifdef HAS_MKOSTEMP
+#           error 134221 will need a new solution for VMS
+#       endif
+#   else
+#       define O_VMS_DELETEONCLOSE 0
+#   endif
+#endif
 #if defined(HAS_MKOSTEMP) && defined(PERL_CORE)
 #   define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags)
 #endif