(perl #134221) support append mode for open .. undef

doio.c

@@ -265,6 +265,21 @@ Perl_my_mkstemp_cloexec(char *templte)
 #endif
 }
 
+int
+Perl_my_mkostemp_cloexec(char *templte, int flags)
+{
+    dVAR;
+    PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC;
+#if defined(O_CLOEXEC)
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+        PL_strategy_mkstemp,
+	Perl_my_mkostemp(templte, flags | O_CLOEXEC),
+	Perl_my_mkostemp(templte, flags));
+#else
+    DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkostemp(templte, flags));
+#endif
+}
+
 #ifdef HAS_PIPE
 int
 Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)

embed.fnc

@@ -543,6 +543,7 @@ p	|int	|PerlLIO_dup2_cloexec|int oldfd|int newfd
 pR	|int	|PerlLIO_open_cloexec|NN const char *file|int flag
 pR	|int	|PerlLIO_open3_cloexec|NN const char *file|int flag|int perm
 pToR	|int	|my_mkstemp_cloexec|NN char *templte
+pToR	|int	|my_mkostemp_cloexec|NN char *templte|int flags
 #ifdef HAS_PIPE
 pR	|int	|PerlProc_pipe_cloexec|NN int *pipefd
 #endif

perlio.c

@@ -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())) {
+        int 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)
@@ -5042,6 +5044,15 @@ PerlIO_stdoutf(const char *fmt, ...)
 #undef PerlIO_tmpfile
 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;
@@ -5057,27 +5068,32 @@ PerlIO_tmpfile(void)
      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);
      }
      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);
      }
      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);
      }
      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;
 	  PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname);

perlio.h

@@ -286,6 +286,9 @@ PERL_CALLCONV SSize_t PerlIO_get_bufsiz(PerlIO *);
 #ifndef PerlIO_tmpfile
 PERL_CALLCONV PerlIO *PerlIO_tmpfile(void);
 #endif
+#ifndef PerlIO_tmpfile_flags
+PERL_CALLCONV PerlIO *PerlIO_tmpfile_flags(int flags);
+#endif
 #ifndef PerlIO_stdin
 PERL_CALLCONV PerlIO *PerlIO_stdin(void);
 #endif

proto.h

@@ -2275,6 +2275,11 @@ PERL_CALLCONV Pid_t	Perl_my_fork(void);
 PERL_CALLCONV I32	Perl_my_lstat(pTHX);
 #endif
 PERL_CALLCONV I32	Perl_my_lstat_flags(pTHX_ const U32 flags);
+PERL_CALLCONV int	Perl_my_mkostemp_cloexec(char *templte, int flags)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC	\
+	assert(templte)
+
 PERL_CALLCONV int	Perl_my_mkstemp_cloexec(char *templte)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC	\

t/io/perlio_open.t

@@ -11,7 +11,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan tests => 6;
+plan tests => 10;
 
 use Fcntl qw(:seek);
 
@@ -31,6 +31,16 @@ use Fcntl qw(:seek);
     is($data, "the right read stuff", "found the right stuff");
 }
 
-
+SKIP:
+{
+    ok((open my $fh, "+>>", undef), "open my \$fh, '+>>', undef")
+      or skip "can't open temp for append: $!", 3;
+    print $fh "abc";
+    ok(seek($fh, 0, SEEK_SET), "seek to zero");
+    print $fh "xyz";
+    ok(seek($fh, 0, SEEK_SET), "seek to zero again");
+    my $data = <$fh>;
+    is($data, "abcxyz", "check the second write appended");
+}