Merge simple tied handle method calls into S_tied_handle_method().

diff --git a/embed.fnc b/embed.fnc
index 36d8c1a..1a118b1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1716,6 +1716,8 @@ s |OP*    |doform         |NN CV *cv|NN GV *gv|NN OP *retop
 sR     |int    |dooneliner     |NN const char *cmd|NN const char *filename
 #  endif
 s      |SV *   |space_join_names_mortal|NN char *const *array
+s      |OP *   |tied_handle_method|NN const char *const methname|NN SV **sp \
+                               |NN IO *const io|NN MAGIC *const mg
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)

diff --git a/embed.h b/embed.h
index 80457a2..4fe29c4 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1455,6 +1455,7 @@
 #  endif
 #ifdef PERL_CORE
 #define space_join_names_mortal        S_space_join_names_mortal
+#define tied_handle_method     S_tied_handle_method
 #endif
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
@@ -3895,6 +3896,7 @@
 #  endif
 #ifdef PERL_CORE
 #define space_join_names_mortal(a)     S_space_join_names_mortal(aTHX_ a)
+#define tied_handle_method(a,b,c,d)    S_tied_handle_method(aTHX_ a,b,c,d)
 #endif
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)

diff --git a/pp_sys.c b/pp_sys.c
index a39453b..0fe80b4 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -552,6 +552,21 @@ PP(pp_open)
     RETURN;
 }
 
+static OP *
+S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
+                    IO *const io, MAGIC *const mg)
+{
+    PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
+
+    PUSHMARK(sp);
+    PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
+    PUTBACK;
+    ENTER_with_name("call_tied_handle_method");
+    call_method(methname, G_SCALAR);
+    LEAVE_with_name("call_tied_handle_method");
+    return NORMAL;
+}
+
 PP(pp_close)
 {
     dVAR; dSP;
@@ -565,14 +580,7 @@ PP(pp_close)
        if (io) {
            MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
            if (mg) {
-               PUSHMARK(SP);
-               PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-               PUTBACK;
-               ENTER_with_name("call_CLOSE");
-               call_method("CLOSE", G_SCALAR);
-               LEAVE_with_name("call_CLOSE");
-               SPAGAIN;
-               RETURN;
+               return tied_handle_method("CLOSE", SP, io, mg);
            }
        }
     }
@@ -655,14 +663,7 @@ PP(pp_fileno)
     if (gv && (io = GvIO(gv))
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
-       PUSHMARK(SP);
-       PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-       PUTBACK;
-       ENTER_with_name("call_FILENO");
-       call_method("FILENO", G_SCALAR);
-       LEAVE_with_name("call_FILENO");
-       SPAGAIN;
-       RETURN;
+       return tied_handle_method("FILENO", SP, io, mg);
     }
 
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
@@ -2084,14 +2085,7 @@ PP(pp_tell)
     if (gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(SP);
-           PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER;
-           call_method("TELL", G_SCALAR);
-           LEAVE;
-           SPAGAIN;
-           RETURN;
+           return tied_handle_method("TELL", SP, io, mg);
        }
     }
     else if (!gv) {

diff --git a/proto.h b/proto.h
index 271107f..2721fac 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5350,6 +5350,14 @@ STATIC SV *      S_space_join_names_mortal(pTHX_ char *const *array)
 #define PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL       \
        assert(array)
 
+STATIC OP *    S_tied_handle_method(pTHX_ const char *const methname, SV **sp, IO *const io, MAGIC *const mg)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_TIED_HANDLE_METHOD    \
+       assert(methname); assert(sp); assert(io); assert(mg)
+
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)