Split ck_open into two functions

It is used for two op types, but only a small portion of it applies
to both, so we can put that in a static function.  This makes the
next commit easier.

diff --git a/embed.h b/embed.h
index a172226..570ed12 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1033,6 +1033,7 @@
 #define cando(a,b,c)           Perl_cando(aTHX_ a,b,c)
 #define check_utf8_print(a,b)  Perl_check_utf8_print(aTHX_ a,b)
 #define ck_anoncode(a)         Perl_ck_anoncode(aTHX_ a)
+#define ck_backtick(a)         Perl_ck_backtick(aTHX_ a)
 #define ck_bitop(a)            Perl_ck_bitop(aTHX_ a)
 #define ck_cmp(a)              Perl_ck_cmp(aTHX_ a)
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)

diff --git a/op.c b/op.c
index 12722dd..fb214d9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8409,6 +8409,53 @@ Perl_ck_anoncode(pTHX_ OP *o)
     return o;
 }
 
+static void
+S_io_hints(pTHX_ OP *o)
+{
+    HV * const table =
+       PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;;
+    if (table) {
+       SV **svp = hv_fetchs(table, "open_IN", FALSE);
+       if (svp && *svp) {
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_IN_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_IN_CRLF;
+       }
+
+       svp = hv_fetchs(table, "open_OUT", FALSE);
+       if (svp && *svp) {
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_OUT_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_OUT_CRLF;
+       }
+    }
+}
+
+OP *
+Perl_ck_backtick(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_CK_BACKTICK;
+    S_io_hints(aTHX_ o);
+    if (!(o->op_flags & OPf_KIDS)) {
+       OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+#ifdef PERL_MAD
+       op_getmad(o,newop,'O');
+#else
+       op_free(o);
+#endif
+       return newop;
+    }
+    return o;
+}
+
 OP *
 Perl_ck_bitop(pTHX_ OP *o)
 {
@@ -9603,46 +9650,10 @@ OP *
 Perl_ck_open(pTHX_ OP *o)
 {
     dVAR;
-    HV * const table =
-       PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;;
 
     PERL_ARGS_ASSERT_CK_OPEN;
 
-    if (table) {
-       SV **svp = hv_fetchs(table, "open_IN", FALSE);
-       if (svp && *svp) {
-           STRLEN len = 0;
-           const char *d = SvPV_const(*svp, len);
-           const I32 mode = mode_from_discipline(d, len);
-           if (mode & O_BINARY)
-               o->op_private |= OPpOPEN_IN_RAW;
-           else if (mode & O_TEXT)
-               o->op_private |= OPpOPEN_IN_CRLF;
-       }
-
-       svp = hv_fetchs(table, "open_OUT", FALSE);
-       if (svp && *svp) {
-           STRLEN len = 0;
-           const char *d = SvPV_const(*svp, len);
-           const I32 mode = mode_from_discipline(d, len);
-           if (mode & O_BINARY)
-               o->op_private |= OPpOPEN_OUT_RAW;
-           else if (mode & O_TEXT)
-               o->op_private |= OPpOPEN_OUT_CRLF;
-       }
-    }
-    if (o->op_type == OP_BACKTICK) {
-       if (!(o->op_flags & OPf_KIDS)) {
-           OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
-#ifdef PERL_MAD
-           op_getmad(o,newop,'O');
-#else
-           op_free(o);
-#endif
-           return newop;
-       }
-       return o;
-    }
+    S_io_hints(aTHX_ o);
     {
         /* In case of three-arg dup open remove strictness
          * from the last arg if it is a bareword. */

diff --git a/opcode.h b/opcode.h
index 4406782..9a9ef1e 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1357,7 +1357,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_null,           /* srefgen */
        Perl_ck_fun,            /* ref */
        Perl_ck_fun,            /* bless */
-       Perl_ck_open,           /* backtick */
+       Perl_ck_backtick,       /* backtick */
        Perl_ck_glob,           /* glob */
        Perl_ck_readline,       /* readline */
        Perl_ck_null,           /* rcatline */

diff --git a/proto.h b/proto.h
index 2d4b155..c8811e4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -365,6 +365,12 @@ PERL_CALLCONV OP * Perl_ck_anoncode(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_ANONCODE   \
        assert(o)
 
+PERL_CALLCONV OP *     Perl_ck_backtick(pTHX_ OP *o)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CK_BACKTICK   \
+       assert(o)
+
 PERL_CALLCONV OP *     Perl_ck_bitop(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/regen/opcodes b/regen/opcodes
index b15fa20..f904b06 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -73,7 +73,7 @@ bless         bless                   ck_fun          s@      S S?
 
 # Pushy I/O.
 
-backtick       quoted execution (``, qx)       ck_open         tu%     S?
+backtick       quoted execution (``, qx)       ck_backtick     tu%     S?
 # glob defaults its first arg to $_
 glob           glob                    ck_glob         t@      S?
 readline       <HANDLE>                ck_readline     t%      F?