use cv_set_call_checker_flags() where possible

Call checkers established by core code were being set through
cv_set_call_checker(), so requiring GVs to be created in some cases where
they could be avoided.  Make all the checkers non-GV-namegv capable,
and set them with cv_set_call_checker_flags().

The checkers for Devel::Peek::Dump() and
utf8::{unicode_to_native,native_to_unicode}() were already fit to handle
non-GV names, so required no changes.  The checker for CORE:: subs,
ck_entersub_args_core(), was naughtily using the name to decide which sub
it was dealing with in some cases, so move that information into the ckobj
that was already being used to identify the sub in most cases.  It also
required reformulation of some error reporting code to use cv_name().

5 files changed, 24 insertions, 18 deletions

diff --git a/ext/Devel-Peek/Peek.pm b/ext/Devel-Peek/Peek.pm
index 4ce8b4531b..3d790e763a 100644
--- a/ext/Devel-Peek/Peek.pm
+++ b/ext/Devel-Peek/Peek.pm
@@ -3,7 +3,7 @@
 
 package Devel::Peek;
 
-$VERSION = '1.26';
+$VERSION = '1.27';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
diff --git a/ext/Devel-Peek/Peek.xs b/ext/Devel-Peek/Peek.xs
index cde3e51dec..8a8c0b96d7 100644
--- a/ext/Devel-Peek/Peek.xs
+++ b/ext/Devel-Peek/Peek.xs
@@ -444,7 +444,7 @@ BOOT:
 {
     CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0);
     assert(cv);
-    cv_set_call_checker(cv, S_ck_dump, (SV *)cv);
+    cv_set_call_checker_flags(cv, S_ck_dump, (SV *)cv, 0);
     Perl_custom_op_register(aTHX_ S_pp_dump, &my_xop);
 }
 
diff --git a/gv.c b/gv.c
index 39782bcb5e..afddfe48a8 100644
--- a/gv.c
+++ b/gv.c
@@ -608,11 +608,12 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
 	PL_compcv = oldcompcv;
     }
     if (cv) {
-        SV *opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
-        cv_set_call_checker(
-          cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
-        );
-        SvREFCNT_dec(opnumsv);
+	SV *opnumsv = newSViv(
+	    (opnum == OP_ENTEREVAL && len == 9 && memEQ(name, "evalbytes", 9)) ?
+		(OP_ENTEREVAL | (1<<16))
+	    : opnum ? opnum : (((I32)name[2]) << 16));
+        cv_set_call_checker_flags(cv, Perl_ck_entersub_args_core, opnumsv, 0);
+	SvREFCNT_dec_NN(opnumsv);
     }
 
     return gv;
diff --git a/op.c b/op.c
index 598d4ac0c0..e8fbb1eeb0 100644
--- a/op.c
+++ b/op.c
@@ -11929,7 +11929,8 @@ Perl_ck_entersub_args_proto_or_list(pTHX_ OP *entersubop,
 OP *
 Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 {
-    int opnum = SvTYPE(protosv) == SVt_PVCV ? 0 : (int)SvUV(protosv);
+    IV cvflags = SvIVX(protosv);
+    int opnum = cvflags & 0xffff;
     OP *aop = cUNOPx(entersubop)->op_first;
 
     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_CORE;
@@ -11940,11 +11941,14 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    aop = cUNOPx(aop)->op_first;
 	aop = OpSIBLING(aop);
 	for (cvop = aop; OpSIBLING(cvop); cvop = OpSIBLING(cvop)) ;
-	if (aop != cvop)
-	    (void)too_many_arguments_pv(entersubop, GvNAME(namegv), 0);
+	if (aop != cvop) {
+	    SV *namesv = cv_name((CV *)namegv, NULL, CV_NAME_NOTQUAL);
+	    yyerror_pv(Perl_form(aTHX_ "Too many arguments for %" SVf,
+		SVfARG(namesv)), SvUTF8(namesv));
+	}
 	
 	op_free(entersubop);
-	switch(GvNAME(namegv)[2]) {
+	switch(cvflags >> 16) {
 	case 'F': return newSVOP(OP_CONST, 0,
 					newSVpv(CopFILE(PL_curcop),0));
 	case 'L': return newSVOP(
@@ -11997,8 +12001,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
             op_sibling_splice(parent, first, -1, NULL);
 	op_free(entersubop);
 
-	if (opnum == OP_ENTEREVAL
-	 && GvNAMELEN(namegv)==9 && strnEQ(GvNAME(namegv), "evalbytes", 9))
+	if (cvflags == (OP_ENTEREVAL | (1<<16)))
 	    flags |= OPpEVAL_BYTES <<8;
 	
 	switch (PL_opargs[opnum] & OA_CLASS_MASK) {
@@ -12008,7 +12011,9 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    return aop ? newUNOP(opnum,flags,aop) : newOP(opnum,flags);
 	case OA_BASEOP:
 	    if (aop) {
-		    (void)too_many_arguments_pv(aop, GvNAME(namegv), 0);
+		SV *namesv = cv_name((CV *)namegv, NULL, CV_NAME_NOTQUAL);
+		yyerror_pv(Perl_form(aTHX_ "Too many arguments for %" SVf,
+		    SVfARG(namesv)), SvUTF8(namesv));
 		op_free(aop);
 	    }
 	    return opnum == OP_RUNCV
diff --git a/universal.c b/universal.c
index 6ee65a6a11..65477fb775 100644
--- a/universal.c
+++ b/universal.c
@@ -1089,12 +1089,12 @@ Perl_boot_core_UNIVERSAL(pTHX)
         CV* to_native_cv = get_cv("utf8::unicode_to_native", 0);
         CV* to_unicode_cv = get_cv("utf8::native_to_unicode", 0);
 
-        cv_set_call_checker(to_native_cv,
+        cv_set_call_checker_flags(to_native_cv,
                             optimize_out_native_convert_function,
-                            (SV*) to_native_cv);
-        cv_set_call_checker(to_unicode_cv,
+                            (SV*) to_native_cv, 0);
+        cv_set_call_checker_flags(to_unicode_cv,
                             optimize_out_native_convert_function,
-                            (SV*) to_unicode_cv);
+                            (SV*) to_unicode_cv, 0);
     }
 #endif