op.c: Warnings cleanup.

7 files changed, 172 insertions, 61 deletions

diff --git a/MANIFEST b/MANIFEST
index 646fc80534..cc185d6dda 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5496,6 +5496,7 @@ t/uni/latin2.t			See if Unicode in latin2 works
 t/uni/lex_utf8.t		See if Unicode in lexer works
 t/uni/lower.t			See if Unicode casing works
 t/uni/method.t			See if Unicode methods work
+t/uni/opcroak.t			See if Unicode croaks from op.c work
 t/uni/overload.t		See if Unicode overloading works
 t/uni/package.t			See if Unicode in package declarations works
 t/uni/parser.t			See if Unicode in the parser works in edge cases.
diff --git a/embed.fnc b/embed.fnc
index 6337942f98..8e3527d5e4 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1741,17 +1741,20 @@ sR	|OP*	|newDEFSVOP
 sR	|OP*	|search_const	|NN OP *o
 sR	|OP*	|new_logop	|I32 type|I32 flags|NN OP **firstp|NN OP **otherp
 s	|void	|simplify_sort	|NN OP *o
-s	|const char*	|gv_ename	|NN GV *gv
+s	|SV*	|gv_ename	|NN GV *gv
 sRn	|bool	|scalar_mod_type|NULLOK const OP *o|I32 type
 s	|OP *	|my_kid		|NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
 s	|OP *	|dup_attrlist	|NN OP *o
 s	|void	|apply_attrs	|NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my
 s	|void	|apply_attrs_my	|NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp
-s	|void	|bad_type	|I32 n|NN const char *t|NN const char *name|NN const OP *kid
+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	|no_bareword_allowed|NN OP *o
 sR	|OP*	|no_fh_allowed|NN OP *o
-sR	|OP*	|too_few_arguments|NN OP *o|NN const char* name
-s	|OP*	|too_many_arguments|NN OP *o|NN const char* name
+sR	|OP*	|too_few_arguments_sv|NN OP *o|NN SV* namesv|U32 flags
+sR	|OP*	|too_few_arguments_pv|NN OP *o|NN const char* name|U32 flags
+s	|OP*	|too_many_arguments_pv|NN OP *o|NN const char* name|U32 flags
+sR	|OP*	|too_many_arguments_sv|NN OP *o|NN SV* namesv|U32 flags
 s	|bool	|looks_like_bool|NN const OP* o
 s	|OP*	|newGIVWHENOP	|NULLOK OP* cond|NN OP *block \
 				|I32 enter_opcode|I32 leave_opcode \
diff --git a/embed.h b/embed.h
index 6f13c91479..24f1e4a604 100644
--- a/embed.h
+++ b/embed.h
@@ -1387,7 +1387,8 @@
 #define aassign_common_vars(a)	S_aassign_common_vars(aTHX_ a)
 #define apply_attrs(a,b,c,d)	S_apply_attrs(aTHX_ a,b,c,d)
 #define apply_attrs_my(a,b,c,d)	S_apply_attrs_my(aTHX_ a,b,c,d)
-#define bad_type(a,b,c,d)	S_bad_type(aTHX_ a,b,c,d)
+#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)
@@ -1421,8 +1422,10 @@
 #define scalarseq(a)		S_scalarseq(aTHX_ a)
 #define search_const(a)		S_search_const(aTHX_ a)
 #define simplify_sort(a)	S_simplify_sort(aTHX_ a)
-#define too_few_arguments(a,b)	S_too_few_arguments(aTHX_ a,b)
-#define too_many_arguments(a,b)	S_too_many_arguments(aTHX_ a,b)
+#define too_few_arguments_pv(a,b,c)	S_too_few_arguments_pv(aTHX_ a,b,c)
+#define too_few_arguments_sv(a,b,c)	S_too_few_arguments_sv(aTHX_ a,b,c)
+#define too_many_arguments_pv(a,b,c)	S_too_many_arguments_pv(aTHX_ a,b,c)
+#define too_many_arguments_sv(a,b,c)	S_too_many_arguments_sv(aTHX_ a,b,c)
 #  endif
 #  if defined(PERL_IN_OP_C) || defined(PERL_IN_SV_C)
 #define report_redefined_cv(a,b,c)	Perl_report_redefined_cv(aTHX_ a,b,c)
diff --git a/op.c b/op.c
index 3bbe4f1177..49aa1e4417 100644
--- a/op.c
+++ b/op.c
@@ -317,7 +317,7 @@ Perl_Slab_Free(pTHX_ void *op)
 	o->op_ppaddr = PL_ppaddr[type];		\
     } STMT_END
 
-STATIC const char*
+STATIC SV*
 S_gv_ename(pTHX_ GV *gv)
 {
     SV* const tmpsv = sv_newmortal();
@@ -325,7 +325,7 @@ S_gv_ename(pTHX_ GV *gv)
     PERL_ARGS_ASSERT_GV_ENAME;
 
     gv_efullname3(tmpsv, gv, NULL);
-    return SvPV_nolen_const(tmpsv);
+    return tmpsv;
 }
 
 STATIC OP *
@@ -339,30 +339,57 @@ S_no_fh_allowed(pTHX_ OP *o)
 }
 
 STATIC OP *
-S_too_few_arguments(pTHX_ OP *o, const char *name)
+S_too_few_arguments_sv(pTHX_ OP *o, SV *namesv, U32 flags)
 {
-    PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS;
+    PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_SV;
+    yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %"SVf, namesv),
+                                    SvUTF8(namesv) | flags);
+    return o;
+}
+
+STATIC OP *
+S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
+{
+    PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_PV;
+    yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %s", name), flags);
+    return o;
+}
+ 
+STATIC OP *
+S_too_many_arguments_pv(pTHX_ OP *o, const char *name, U32 flags)
+{
+    PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV;
 
-    yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name));
+    yyerror_pv(Perl_form(aTHX_ "Too many arguments for %s", name), flags);
     return o;
 }
 
 STATIC OP *
-S_too_many_arguments(pTHX_ OP *o, const char *name)
+S_too_many_arguments_sv(pTHX_ OP *o, SV *namesv, U32 flags)
 {
-    PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS;
+    PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_SV;
 
-    yyerror(Perl_form(aTHX_ "Too many arguments for %s", name));
+    yyerror_pv(Perl_form(aTHX_ "Too many arguments for %"SVf, SVfARG(namesv)),
+                SvUTF8(namesv) | flags);
     return o;
 }
 
 STATIC void
-S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid)
+S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid)
 {
-    PERL_ARGS_ASSERT_BAD_TYPE;
+    PERL_ARGS_ASSERT_BAD_TYPE_PV;
+
+    yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
+		 (int)n, name, t, OP_DESC(kid)), flags);
+}
 
-    yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
-		 (int)n, name, t, OP_DESC(kid)));
+STATIC void
+S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid)
+{
+    PERL_ARGS_ASSERT_BAD_TYPE_SV;
+ 
+    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);
 }
 
 STATIC void
@@ -410,8 +437,8 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 			      name[0], toCTRL(name[1]), (int)(len - 2), name + 2,
 			      PL_parser->in_my == KEY_state ? "state" : "my"));
 	} else {
-	    yyerror(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name,
-			      PL_parser->in_my == KEY_state ? "state" : "my"));
+	    yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name,
+			      PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
 	}
     }
 
@@ -1625,9 +1652,10 @@ S_finalize_op(pTHX_ OP* o)
 	key = SvPV_const(*svp, keylen);
 	if (!hv_fetch(GvHV(*fields), key,
 		SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE)) {
-	    Perl_croak(aTHX_ "No such class field \"%s\" "
-		"in variable %s of type %s",
-		key, SvPV_nolen_const(lexname), HvNAME_get(SvSTASH(lexname)));
+	    Perl_croak(aTHX_ "No such class field \"%"SVf"\" " 
+			   "in variable %"SVf" of type %"SVf, 
+		      SVfARG(*svp), SVfARG(lexname),
+                      SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(lexname))))));
 	}
 	break;
     }
@@ -1680,9 +1708,10 @@ S_finalize_op(pTHX_ OP* o)
 	    key = SvPV_const(*svp, keylen);
 	    if (!hv_fetch(GvHV(*fields), key,
 		    SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE)) {
-		Perl_croak(aTHX_ "No such class field \"%s\" "
-		    "in variable %s of type %s",
-		    key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
+		Perl_croak(aTHX_ "No such class field \"%"SVf"\" " 
+			   "in variable %"SVf" of type %"SVf, 
+		      SVfARG(*svp), SVfARG(lexname),
+                      SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(lexname))))));
 	    }
 	}
 	break;
@@ -7833,7 +7862,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		if (numargs == 1 && !(oa >> 4)
 		    && kid->op_type == OP_LIST && type != OP_SCALAR)
 		{
-		    return too_many_arguments(o,PL_op_desc[type]);
+		    return too_many_arguments_pv(o,PL_op_desc[type], 0);
 		}
 		scalar(kid);
 		break;
@@ -7873,7 +7902,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		      && (  !SvROK(cSVOPx_sv(kid)) 
 		         || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV  )
 		        )
-		    bad_type(numargs, "array", PL_op_desc[type], kid);
+		    bad_type_pv(numargs, "array", PL_op_desc[type], 0, kid);
 		/* Defer checks to run-time if we have a scalar arg */
 		if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
 		    op_lvalue(kid, type);
@@ -7898,7 +7927,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		    *tokid = kid;
 		}
 		else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
-		    bad_type(numargs, "hash", PL_op_desc[type], kid);
+		    bad_type_pv(numargs, "hash", PL_op_desc[type], 0, kid);
 		op_lvalue(kid, type);
 		break;
 	    case OA_CVREF:
@@ -7931,7 +7960,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		    }
 		    else if (kid->op_type == OP_READLINE) {
 			/* neophyte patrol: open(<FH>), close(<FH>) etc. */
-			bad_type(numargs, "HANDLE", OP_DESC(o), kid);
+			bad_type_pv(numargs, "HANDLE", OP_DESC(o), 0, kid);
 		    }
 		    else {
 			I32 flags = OPf_SPECIAL;
@@ -8045,13 +8074,13 @@ Perl_ck_fun(pTHX_ OP *o)
 	}
 #ifdef PERL_MAD
 	if (kid && kid->op_type != OP_STUB)
-	    return too_many_arguments(o,OP_DESC(o));
+	    return too_many_arguments_pv(o,OP_DESC(o), 0);
 	o->op_private |= numargs;
 #else
 	/* FIXME - should the numargs move as for the PERL_MAD case?  */
 	o->op_private |= numargs;
 	if (kid)
-	    return too_many_arguments(o,OP_DESC(o));
+	    return too_many_arguments_pv(o,OP_DESC(o), 0);
 #endif
 	listkids(o);
     }
@@ -8071,7 +8100,7 @@ Perl_ck_fun(pTHX_ OP *o)
 	while (oa & OA_OPTIONAL)
 	    oa >>= 4;
 	if (oa && oa != OA_LIST)
-	    return too_few_arguments(o,OP_DESC(o));
+	    return too_few_arguments_pv(o,OP_DESC(o), 0);
     }
     return o;
 }
@@ -8202,7 +8231,7 @@ Perl_ck_grep(pTHX_ OP *o)
 
     kid = cLISTOPo->op_first->op_sibling;
     if (!kid || !kid->op_sibling)
-	return too_few_arguments(o,OP_DESC(o));
+	return too_few_arguments_pv(o,OP_DESC(o), 0);
     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
 	op_lvalue(kid, OP_GREPSTART);
 
@@ -8929,7 +8958,7 @@ Perl_ck_split(pTHX_ OP *o)
     scalar(kid);
 
     if (kid->op_sibling)
-	return too_many_arguments(o,OP_DESC(o));
+	return too_many_arguments_pv(o,OP_DESC(o), 0);
 
     return o;
 }
@@ -8944,11 +8973,13 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
 	if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-	    const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING";
-	    const STRLEN len = re ? RX_PRELEN(re) : 6;
+            const SV *msg = re
+                    ? newSVpvn_flags( RX_PRECOMP_const(re), RX_PRELEN(re),
+                                            SVs_TEMP | ( RX_UTF8(re) ? SVf_UTF8 : 0 ) )
+                    : newSVpvs_flags( "STRING", SVs_TEMP );
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-			"/%.*s/ should probably be written as \"%.*s\"",
-			(int)len, pmstr, (int)len, pmstr);
+			"/%"SVf"/ should probably be written as \"%"SVf"\"",
+			SVfARG(msg), SVfARG(msg));
 	}
     }
     return ck_fun(o);
@@ -9135,7 +9166,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    o3 = aop;
 
 	if (proto >= proto_end)
-	    return too_many_arguments(entersubop, gv_ename(namegv));
+	    return too_many_arguments_sv(entersubop, gv_ename(namegv), 0);
 
 	switch (*proto) {
 	    case ';':
@@ -9160,9 +9191,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(arg,
+		    bad_type_sv(arg,
 			    arg == 1 ? "block or sub {}" : "sub {}",
-			    gv_ename(namegv), o3);
+			    gv_ename(namegv), 0, o3);
 		break;
 	    case '*':
 		/* '*' allows any scalar type, including bareword */
@@ -9247,9 +9278,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(arg, Perl_form(aTHX_ "one of %.*s",
+			    bad_type_sv(arg, Perl_form(aTHX_ "one of %.*s",
 					(int)(end - p), p),
-				    gv_ename(namegv), o3);
+				    gv_ename(namegv), 0, o3);
 			} else
 			    goto oops;
 			break;
@@ -9257,13 +9288,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(arg, "symbol", gv_ename(namegv), o3);
+			    bad_type_sv(arg, "symbol", gv_ename(namegv), 0, o3);
 			break;
 		    case '&':
 			if (o3->op_type == OP_ENTERSUB)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type(arg, "subroutine entry", gv_ename(namegv),
+			    bad_type_sv(arg, "subroutine entry", gv_ename(namegv), 0,
 				    o3);
 			break;
 		    case '$':
@@ -9279,7 +9310,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(arg, "scalar", gv_ename(namegv), o3);
+			    bad_type_sv(arg, "scalar", gv_ename(namegv), 0, o3);
 			}
 			break;
 		    case '@':
@@ -9287,14 +9318,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				o3->op_type == OP_PADAV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type(arg, "array", gv_ename(namegv), o3);
+			    bad_type_sv(arg, "array", gv_ename(namegv), 0, o3);
 			break;
 		    case '%':
 			if (o3->op_type == OP_RV2HV ||
 				o3->op_type == OP_PADHV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type(arg, "hash", gv_ename(namegv), o3);
+			    bad_type_sv(arg, "hash", gv_ename(namegv), 0, o3);
 			break;
 		    wrapref:
 			{
@@ -9339,7 +9370,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     }
     if (!optional && proto_end > proto &&
 	(*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_'))
-	return too_few_arguments(entersubop, gv_ename(namegv));
+	return too_few_arguments_sv(entersubop, gv_ename(namegv), 0);
     return entersubop;
 }
 
@@ -9399,7 +9430,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    aop = aop->op_sibling;
 	}
 	if (aop != cvop)
-	    (void)too_many_arguments(entersubop, GvNAME(namegv));
+	    (void)too_many_arguments_pv(entersubop, GvNAME(namegv), 0);
 	
 	op_free(entersubop);
 	switch(GvNAME(namegv)[2]) {
@@ -9460,7 +9491,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 #ifdef PERL_MAD
 		if (!PL_madskills || seenarg)
 #endif
-		    (void)too_many_arguments(aop, GvNAME(namegv));
+		    (void)too_many_arguments_pv(aop, GvNAME(namegv), 0);
 		op_free(aop);
 	    }
 	    return opnum == OP_RUNCV
diff --git a/proto.h b/proto.h
index 88c3378b0c..781719be63 100644
--- a/proto.h
+++ b/proto.h
@@ -5726,13 +5726,20 @@ 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(pTHX_ I32 n, const char *t, const char *name, 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_4);
-#define PERL_ARGS_ASSERT_BAD_TYPE	\
+			__attribute__nonnull__(pTHX_5);
+#define PERL_ARGS_ASSERT_BAD_TYPE_PV	\
 	assert(t); assert(name); assert(kid)
 
+STATIC void	S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, 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)
+
 STATIC void	S_cop_free(pTHX_ COP *cop)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_COP_FREE	\
@@ -5760,7 +5767,7 @@ STATIC OP*	S_fold_constants(pTHX_ OP *o)
 
 STATIC OP*	S_force_list(pTHX_ OP* arg);
 STATIC OP*	S_gen_constant_list(pTHX_ OP* o);
-STATIC const char*	S_gv_ename(pTHX_ GV *gv)
+STATIC SV*	S_gv_ename(pTHX_ GV *gv)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_ENAME	\
 	assert(gv)
@@ -5869,19 +5876,33 @@ STATIC void	S_simplify_sort(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_SIMPLIFY_SORT	\
 	assert(o)
 
-STATIC OP*	S_too_few_arguments(pTHX_ OP *o, const char* name)
+STATIC OP*	S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS	\
+#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_PV	\
 	assert(o); assert(name)
 
-STATIC OP*	S_too_many_arguments(pTHX_ OP *o, const char* name)
+STATIC OP*	S_too_few_arguments_sv(pTHX_ OP *o, SV* namesv, U32 flags)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_SV	\
+	assert(o); assert(namesv)
+
+STATIC OP*	S_too_many_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS	\
+#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV	\
 	assert(o); assert(name)
 
+STATIC OP*	S_too_many_arguments_sv(pTHX_ OP *o, SV* namesv, U32 flags)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_SV	\
+	assert(o); assert(namesv)
+
 #  if defined(USE_ITHREADS)
 STATIC void	S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
 			__attribute__nonnull__(pTHX_1);
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 8f579201eb..f2270dc01a 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -991,6 +991,14 @@ join /---/, 'x', 'y', 'z';
 EXPECT
 /---/ should probably be written as "---" at - line 3.
 ########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+join /～～～/, 'x', 'y', 'z';
+EXPECT
+/～～～/ should probably be written as "～～～" at - line 5.
+########
 # op.c [Perl_peep]
 use warnings 'prototype' ;
 fred() ; 
diff --git a/t/uni/opcroak.t b/t/uni/opcroak.t
new file mode 100644
index 0000000000..29909d7cd6
--- /dev/null
+++ b/t/uni/opcroak.t
@@ -0,0 +1,44 @@
+#!./perl
+
+#
+# tests for op.c generated croaks
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+
+plan( tests => 5 );
+
+eval qq!sub \x{30cb} (\$) {} \x{30cb}()!;
+like $@, qr/Not enough arguments for main::\x{30cb}/u, "Not enough arguments croak is UTF-8 clean";
+
+eval qq!sub \x{30cc} (\$) {} \x{30cc}(1, 2)!;
+like $@, qr/Too many arguments for main::\x{30cc}/u, "Too many arguments croak is UTF-8 clean";
+
+eval qq!sub \x{30cd} (\Q\%\E) { 1 } \x{30cd}(1);!;
+like $@, qr/Type of arg 1 to main::\x{30cd} must be/u, "bad type croak is UTF-8 clean";
+
+    eval <<'END_FIELDS';
+    {
+        package ＦŌŌ {
+            use fields qw( a b );
+            sub new { bless {}, shift }
+        }
+    }
+END_FIELDS
+
+for (
+        [ element => 'my ＦŌŌ $bàr = ＦŌŌ->new; $bàr->{クラス};' ],
+        [ slice => 'my ＦŌŌ $bàr = ＦŌŌ->new; @{$bàr}{ qw( a クラス ) };' ]
+    ) {
+    eval $_->[1];
+    
+    like $@, qr/No such class field "クラス" in variable \$bàr of type ＦŌŌ/, "$_->[0]: no such field error is UTF-8 clean";
+}