op.c: Refactor calls to bad_type_sv

Every single caller passes gv_ename(namegv), so make it accept a GV
instead and have *it* call gv_ename(namegv).

diff --git a/embed.fnc b/embed.fnc
index d549962..8098126 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1816,7 +1816,7 @@ s |OP *   |dup_attrlist   |NN OP *o
 s      |void   |apply_attrs    |NN HV *stash|NN SV *target|NULLOK OP *attrs
 s      |void   |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp
 s      |void   |bad_type_pv    |I32 n|NN const char *t|NN const char *name|U32 flags|NN const OP *kid
-s      |void   |bad_type_sv    |I32 n|NN const char *t|NN SV *namesv|U32 flags|NN const OP *kid
+s      |void   |bad_type_gv    |I32 n|NN const char *t|NN GV *gv|U32 flags|NN const OP *kid
 s      |void   |no_bareword_allowed|NN OP *o
 sR     |OP*    |no_fh_allowed|NN OP *o
 sR     |OP*    |too_few_arguments_sv|NN OP *o|NN SV* namesv|U32 flags

diff --git a/embed.h b/embed.h
index 1d7000e..0666e6f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1411,8 +1411,8 @@
 #define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
 #define apply_attrs(a,b,c)     S_apply_attrs(aTHX_ a,b,c)
 #define apply_attrs_my(a,b,c,d)        S_apply_attrs_my(aTHX_ a,b,c,d)
+#define bad_type_gv(a,b,c,d,e) S_bad_type_gv(aTHX_ a,b,c,d,e)
 #define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e)
-#define bad_type_sv(a,b,c,d,e) S_bad_type_sv(aTHX_ a,b,c,d,e)
 #define cop_free(a)            S_cop_free(aTHX_ a)
 #define dup_attrlist(a)                S_dup_attrlist(aTHX_ a)
 #define finalize_op(a)         S_finalize_op(aTHX_ a)

diff --git a/op.c b/op.c
index ce51073..6be3114 100644 (file)
--- a/op.c
+++ b/op.c
@@ -548,9 +548,10 @@ S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP
 }
 
 STATIC void
-S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid)
+S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid)
 {
-    PERL_ARGS_ASSERT_BAD_TYPE_SV;
+    SV * const namesv = gv_ename(gv);
+    PERL_ARGS_ASSERT_BAD_TYPE_GV;
  
     yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)",
                 (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags);
@@ -10121,9 +10122,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                proto++;
                arg++;
                if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
-                   bad_type_sv(arg,
+                   bad_type_gv(arg,
                            arg == 1 ? "block or sub {}" : "sub {}",
-                           gv_ename(namegv), 0, o3);
+                           namegv, 0, o3);
                break;
            case '*':
                /* '*' allows any scalar type, including bareword */
@@ -10208,9 +10209,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                                     OP_READ, /* not entersub */
                                     OP_LVALUE_NO_CROAK
                                    )) goto wrapref;
-                           bad_type_sv(arg, Perl_form(aTHX_ "one of %.*s",
+                           bad_type_gv(arg, Perl_form(aTHX_ "one of %.*s",
                                        (int)(end - p), p),
-                                   gv_ename(namegv), 0, o3);
+                                   namegv, 0, o3);
                        } else
                            goto oops;
                        break;
@@ -10218,13 +10219,13 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                        if (o3->op_type == OP_RV2GV)
                            goto wrapref;
                        if (!contextclass)
-                           bad_type_sv(arg, "symbol", gv_ename(namegv), 0, o3);
+                           bad_type_gv(arg, "symbol", namegv, 0, o3);
                        break;
                    case '&':
                        if (o3->op_type == OP_ENTERSUB)
                            goto wrapref;
                        if (!contextclass)
-                           bad_type_sv(arg, "subroutine entry", gv_ename(namegv), 0,
+                           bad_type_gv(arg, "subroutine entry", namegv, 0,
                                    o3);
                        break;
                    case '$':
@@ -10240,7 +10241,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                                    OP_READ,  /* not entersub */
                                    OP_LVALUE_NO_CROAK
                               )) goto wrapref;
-                           bad_type_sv(arg, "scalar", gv_ename(namegv), 0, o3);
+                           bad_type_gv(arg, "scalar", namegv, 0, o3);
                        }
                        break;
                    case '@':
@@ -10248,14 +10249,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                                o3->op_type == OP_PADAV)
                            goto wrapref;
                        if (!contextclass)
-                           bad_type_sv(arg, "array", gv_ename(namegv), 0, o3);
+                           bad_type_gv(arg, "array", namegv, 0, o3);
                        break;
                    case '%':
                        if (o3->op_type == OP_RV2HV ||
                                o3->op_type == OP_PADHV)
                            goto wrapref;
                        if (!contextclass)
-                           bad_type_sv(arg, "hash", gv_ename(namegv), 0, o3);
+                           bad_type_gv(arg, "hash", namegv, 0, o3);
                        break;
                    wrapref:
                        {

diff --git a/proto.h b/proto.h
index 0630c37..b035d84 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5839,19 +5839,19 @@ STATIC void     S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp
 #define PERL_ARGS_ASSERT_APPLY_ATTRS_MY        \
        assert(stash); assert(target); assert(imopsp)
 
-STATIC void    S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid)
+STATIC void    S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3)
                        __attribute__nonnull__(pTHX_5);
-#define PERL_ARGS_ASSERT_BAD_TYPE_PV   \
-       assert(t); assert(name); assert(kid)
+#define PERL_ARGS_ASSERT_BAD_TYPE_GV   \
+       assert(t); assert(gv); assert(kid)
 
-STATIC void    S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid)
+STATIC void    S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3)
                        __attribute__nonnull__(pTHX_5);
-#define PERL_ARGS_ASSERT_BAD_TYPE_SV   \
-       assert(t); assert(namesv); assert(kid)
+#define PERL_ARGS_ASSERT_BAD_TYPE_PV   \
+       assert(t); assert(name); assert(kid)
 
 STATIC void    S_cop_free(pTHX_ COP *cop)
                        __attribute__nonnull__(pTHX_1);