This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Extract the cleanup code of Perl_do_openn() into S_openn_cleanup().
authorNicholas Clark <nick@ccl4.org>
Sun, 2 Mar 2014 07:14:13 +0000 (08:14 +0100)
committerNicholas Clark <nick@ccl4.org>
Wed, 19 Mar 2014 09:57:53 +0000 (10:57 +0100)
A 12 parameter function is extremely ugly (as demonstrated by the need to add
macros for it to perl.h), but it's private, and it will permit the two-headed
public interface of Perl_do_openn() to be simplified.

doio.c
embed.fnc
embed.h
perl.h
proto.h

diff --git a/doio.c b/doio.c
index 49f1e16..85b3a2d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -136,7 +136,6 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
     IO * const io = openn_setup(gv, mode, &saveifp, &saveofp, &savefd, &savetype);
     int writing = 0;
     PerlIO *fp;
-    int fd;
     bool was_fdopen = FALSE;
     char *type  = NULL;
 
@@ -234,13 +233,16 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
                    Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Can't open a reference");
                SETERRNO(EINVAL, LIB_INVARG);
+                fp = NULL;
                goto say_false;
            }
 #endif /* USE_STDIO */
             p = (SvOK(*svp) || SvGMAGICAL(*svp)) ? SvPV(*svp, nlen) : NULL;
 
-           if (p && !IS_SAFE_PATHNAME(p, nlen, "open"))
+            if (p && !IS_SAFE_PATHNAME(p, nlen, "open")) {
+                fp = NULL;
                 goto say_false;
+            }
 
            name = p ? savepvn(p, nlen) : savepvs("");
 
@@ -279,6 +281,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
                if (ckWARN(WARN_PIPE))
                    Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
                errno = EPIPE;
+                fp = NULL;
                goto say_false;
            }
            if (!(*name == '-' && name[1] == '\0') || num_svs)
@@ -304,6 +307,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
            if (num_svs) {
                if (*type) {
                    if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) {
+                        fp = NULL;
                        goto say_false;
                    }
                }
@@ -371,6 +375,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
 #ifdef EINVAL
                            SETERRNO(EINVAL,SS_IVCHAN);
 #endif
+                            fp = NULL;
                            goto say_false;
                        }
                        if ((that_fp = IoIFP(thatio))) {
@@ -497,6 +502,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
                if (ckWARN(WARN_PIPE))
                    Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
                errno = EPIPE;
+                fp = NULL;
                goto say_false;
            }
            if (!(*name == '-' && name[1] == '\0') || num_svs)
@@ -521,6 +527,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
                    type++;
                if (*type) {
                    if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) {
+                        fp = NULL;
                        goto say_false;
                    }
                }
@@ -556,6 +563,23 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
            }
        }
     }
+
+  say_false:
+    return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
+                         savetype, writing, was_fdopen, type);
+}
+
+/* Yes, this is ugly, but it's private, and I don't see a cleaner way to
+   simplify the two-headed public interface of do_openn. */
+static bool
+S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
+                PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype,
+                int writing, bool was_fdopen, const char *type)
+{
+    int fd;
+
+    PERL_ARGS_ASSERT_OPENN_CLEANUP;
+
     if (!fp) {
        if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
            && strchr(oname, '\n')
index eae8749..44c9211 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -398,6 +398,11 @@ Ap |bool   |do_open9       |NN GV *gv|NN const char *name|I32 len|int as_raw \
 s      |IO *   |openn_setup    |NN GV *gv|NN char *mode|NN PerlIO **saveifp \
                                |NN PerlIO **saveofp|NN int *savefd \
                                 |NN char *savetype
+s      |bool   |openn_cleanup  |NN GV *gv|NN IO *io|NULLOK PerlIO *fp \
+                               |NN char *mode|NN const char *oname \
+                                |NULLOK PerlIO *saveifp|NULLOK PerlIO *saveofp \
+                                |int savefd|char savetype|int writing \
+                                |bool was_fdopen|NULLOK const char *type
 #endif
 Ap     |bool   |do_openn       |NN GV *gv|NN const char *oname|I32 len \
                                |int as_raw|int rawmode|int rawperm \
diff --git a/embed.h b/embed.h
index 0e042ab..9e0ba97 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  if defined(PERL_IN_DOIO_C)
 #define exec_failed(a,b,c)     S_exec_failed(aTHX_ a,b,c)
 #define ingroup(a,b)           S_ingroup(aTHX_ a,b)
+#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l)
 #define openn_setup(a,b,c,d,e,f)       S_openn_setup(aTHX_ a,b,c,d,e,f)
 #  endif
 #  if defined(PERL_IN_DOOP_C)
diff --git a/perl.h b/perl.h
index 574a8a3..6da39f3 100644 (file)
--- a/perl.h
+++ b/perl.h
 #  define pTHX_7       8
 #  define pTHX_8       9
 #  define pTHX_9       10
+#  define pTHX_12      13
 #  if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL)
 #    define PERL_TRACK_MEMPOOL
 #  endif
 #  define pTHX_7       7
 #  define pTHX_8       8
 #  define pTHX_9       9
+#  define pTHX_12      12
 #endif
 
 #ifndef dVAR
diff --git a/proto.h b/proto.h
index 1b0591a..41f8eb0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5712,6 +5712,14 @@ STATIC void      S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
 STATIC bool    S_ingroup(pTHX_ Gid_t testgid, bool effective)
                        __attribute__warn_unused_result__;
 
+STATIC bool    S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *type)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_4)
+                       __attribute__nonnull__(pTHX_5);
+#define PERL_ARGS_ASSERT_OPENN_CLEANUP \
+       assert(gv); assert(io); assert(mode); assert(oname)
+
 STATIC IO *    S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, int *savefd, char *savetype)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)