gv.c: Added gv_init_(sv|pv|pvn), renamed gv_init_sv as gv_init_svtype.

gv_init_pvn() is the same as the old gv_init(), but takes
a flags parameter, which will be used for the UTF-8 cleanup.

The old gv_init() is now implemeneted as a macro in gv.h.

Also included is some minimal testing in XS::APItest.

8 files changed, 97 insertions, 14 deletions

diff --git a/MANIFEST b/MANIFEST
index 432b6af24e..2aa93a3666 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3819,6 +3819,7 @@ ext/XS-APItest/t/exception.t	XS::APItest extension
 ext/XS-APItest/t/fetch_pad_names.t	Tests for UTF8 names in pad
 ext/XS-APItest/t/gotosub.t	XS::APItest: tests goto &xsub and hints
 ext/XS-APItest/t/grok.t		XS::APItest: tests for grok* functions
+ext/XS-APItest/t/gv_init.t	XS::APItest: tests for gv_init and variants
 ext/XS-APItest/t/hash.t		XS::APItest: tests for hash related APIs
 ext/XS-APItest/t/keyword_multiline.t	test keyword plugin parsing across lines
 ext/XS-APItest/t/keyword_plugin.t	test keyword plugin mechanism
diff --git a/embed.fnc b/embed.fnc
index 224339749c..4b1ee0a9ee 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -452,7 +452,11 @@ Ap	|void	|gv_fullname4	|NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool
 pMox	|GP *	|newGP		|NN GV *const gv
 pX	|void	|cvgv_set	|NN CV* cv|NULLOK GV* gv
 pX	|void	|cvstash_set	|NN CV* cv|NULLOK HV* stash
-Ap	|void	|gv_init	|NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi
+Ap	|void	|gv_init_sv	|NN GV* gv|NULLOK HV* stash|NN SV* namesv|int multi|U32 flags
+Ap	|void	|gv_init_pv	|NN GV* gv|NULLOK HV* stash|NN const char* name \
+                                |int multi|U32 flags
+Ap	|void	|gv_init_pvn	|NN GV* gv|NULLOK HV* stash|NN const char* name \
+                                |STRLEN len|int multi|U32 flags
 Ap	|void	|gv_name_set	|NN GV* gv|NN const char *name|U32 len|U32 flags
 XMpd	|void	|gv_try_downgrade|NN GV* gv
 Apd	|HV*	|gv_stashpv	|NN const char* name|I32 flags
@@ -1586,7 +1590,7 @@ sR	|I32	|do_trans_complex_utf8	|NN SV * const sv
 #endif
 
 #if defined(PERL_IN_GV_C)
-s	|void	|gv_init_sv	|NN GV *gv|const svtype sv_type
+s	|void	|gv_init_svtype	|NN GV *gv|const svtype sv_type
 s	|void	|gv_magicalize_isa	|NN GV *gv
 s	|void	|gv_magicalize_overload	|NN GV *gv
 s	|HV*	|gv_get_super_pkg|NN const char* name|I32 namelen
diff --git a/embed.h b/embed.h
index f033d74312..925bb603df 100644
--- a/embed.h
+++ b/embed.h
@@ -179,7 +179,9 @@
 #define gv_fullname(a,b)	Perl_gv_fullname(aTHX_ a,b)
 #define gv_fullname4(a,b,c,d)	Perl_gv_fullname4(aTHX_ a,b,c,d)
 #define gv_handler(a,b)		Perl_gv_handler(aTHX_ a,b)
-#define gv_init(a,b,c,d,e)	Perl_gv_init(aTHX_ a,b,c,d,e)
+#define gv_init_pv(a,b,c,d,e)	Perl_gv_init_pv(aTHX_ a,b,c,d,e)
+#define gv_init_pvn(a,b,c,d,e,f)	Perl_gv_init_pvn(aTHX_ a,b,c,d,e,f)
+#define gv_init_sv(a,b,c,d,e)	Perl_gv_init_sv(aTHX_ a,b,c,d,e)
 #define gv_name_set(a,b,c,d)	Perl_gv_name_set(aTHX_ a,b,c,d)
 #define gv_stashpv(a,b)		Perl_gv_stashpv(aTHX_ a,b)
 #define gv_stashpvn(a,b,c)	Perl_gv_stashpvn(aTHX_ a,b,c)
@@ -1292,7 +1294,7 @@
 #  endif
 #  if defined(PERL_IN_GV_C)
 #define gv_get_super_pkg(a,b)	S_gv_get_super_pkg(aTHX_ a,b)
-#define gv_init_sv(a,b)		S_gv_init_sv(aTHX_ a,b)
+#define gv_init_svtype(a,b)	S_gv_init_svtype(aTHX_ a,b)
 #define gv_magicalize_isa(a)	S_gv_magicalize_isa(aTHX_ a)
 #define gv_magicalize_overload(a)	S_gv_magicalize_overload(aTHX_ a)
 #define require_tie_mod(a,b,c,d,e)	S_require_tie_mod(aTHX_ a,b,c,d,e)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 37f7a0e290..d555931c49 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1840,6 +1840,35 @@ call_method(methname, flags, ...)
 	PUSHs(sv_2mortal(newSViv(i)));
 
 void
+gv_init_type(namesv, multi, flags, type)
+    SV* namesv
+    int multi
+    I32 flags
+    int type
+    PREINIT:
+        STRLEN len;
+        const char * const name = SvPV_const(namesv, len);
+        GV *gv = *(GV**)hv_fetch(PL_defstash, name, len, TRUE);
+    PPCODE:
+        if (SvTYPE(gv) == SVt_PVGV)
+            Perl_croak(aTHX_ "GV is already a PVGV");
+        switch (type) {
+           case 0:
+	       gv_init(gv, PL_defstash, name, len, multi);
+               break;
+           case 1:
+               gv_init_sv(gv, PL_defstash, namesv, multi, flags);
+               break;
+           case 2:
+               gv_init_pv(gv, PL_defstash, name, multi, flags | SvUTF8(namesv));
+               break;
+           case 3:
+               gv_init_pvn(gv, PL_defstash, name, len, multi, flags | SvUTF8(namesv));
+               break;
+        }
+	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
+
+void
 eval_sv(sv, flags)
     SV* sv
     I32 flags
diff --git a/ext/XS-APItest/t/gv_init.t b/ext/XS-APItest/t/gv_init.t
new file mode 100644
index 0000000000..fee41f6cbc
--- /dev/null
+++ b/ext/XS-APItest/t/gv_init.t
@@ -0,0 +1,15 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+use XS::APItest;
+
+is my $glob = XS::APItest::gv_init_type("sanity_check", 0, 0, 0), "*main::sanity_check";
+ok $::{sanity_check};
+
+for my $type (0..3) {
+    is my $glob = XS::APItest::gv_init_type("test$type", 0, 0, $type), "*main::test$type";
+    ok $::{"test$type"};
+}
diff --git a/gv.c b/gv.c
index b5c35906e3..4bb3625d32 100644
--- a/gv.c
+++ b/gv.c
@@ -249,7 +249,26 @@ Perl_cvstash_set(pTHX_ CV *cv, HV *st)
 }
 
 void
-Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
+Perl_gv_init_sv(pTHX_ GV *gv, HV *stash, SV* namesv, int multi, U32 flags)
+{
+   char *namepv;
+   STRLEN namelen;
+   PERL_ARGS_ASSERT_GV_INIT_SV;
+   namepv = SvPV(namesv, namelen);
+   if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+   gv_init_pvn(gv, stash, namepv, namelen, multi, flags);
+}
+
+void
+Perl_gv_init_pv(pTHX_ GV *gv, HV *stash, const char *name, int multi, U32 flags)
+{
+   PERL_ARGS_ASSERT_GV_INIT_PV;
+   gv_init_pvn(gv, stash, name, strlen(name), multi, flags);
+}
+
+void
+Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi, U32 flags)
 {
     dVAR;
     const U32 old_type = SvTYPE(gv);
@@ -259,7 +278,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
     const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
 
-    PERL_ARGS_ASSERT_GV_INIT;
+    PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
 
     if (has_constant) {
@@ -344,9 +363,9 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 }
 
 STATIC void
-S_gv_init_sv(pTHX_ GV *gv, const svtype sv_type)
+S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
 {
-    PERL_ARGS_ASSERT_GV_INIT_SV;
+    PERL_ARGS_ASSERT_GV_INIT_SVTYPE;
 
     switch (sv_type) {
     case SVt_PVIO:
@@ -1397,7 +1416,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if (SvTYPE(gv) == SVt_PVGV) {
 	if (add) {
 	    GvMULTI_on(gv);
-	    gv_init_sv(gv, sv_type);
+	    gv_init_svtype(gv, sv_type);
 	    if (len == 1 && stash == PL_defstash
 		&& (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
 	        if (*name == '!')
@@ -1755,7 +1774,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	    (void)hv_store(stash,name,len,(SV *)gv,0);
 	else SvREFCNT_dec(gv), gv = NULL;
     }
-    if (gv) gv_init_sv(gv, faking_it ? SVt_PVCV : sv_type);
+    if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
     return gv;
 }
 
diff --git a/gv.h b/gv.h
index 6134ba47f9..e48d648604 100644
--- a/gv.h
+++ b/gv.h
@@ -237,6 +237,7 @@ Return the SV from the GV.
 #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
 #define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE)
 #define gv_fetchsv_nomg(n,f,t) gv_fetchsv(n,(f)|GV_NO_SVGMAGIC,t)
+#define gv_init(gv,stash,name,len,multi) gv_init_pvn(gv,stash,name,len,multi,0)
 
 #define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV)
 #define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV)
diff --git a/proto.h b/proto.h
index 1a4e5719b9..054387ab25 100644
--- a/proto.h
+++ b/proto.h
@@ -1256,12 +1256,24 @@ PERL_CALLCONV void	Perl_gv_fullname4(pTHX_ SV* sv, const GV* gv, const char* pre
 PERL_CALLCONV CV*	Perl_gv_handler(pTHX_ HV* stash, I32 id)
 			__attribute__warn_unused_result__;
 
-PERL_CALLCONV void	Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi)
+PERL_CALLCONV void	Perl_gv_init_pv(pTHX_ GV* gv, HV* stash, const char* name, int multi, U32 flags)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_GV_INIT	\
+#define PERL_ARGS_ASSERT_GV_INIT_PV	\
 	assert(gv); assert(name)
 
+PERL_CALLCONV void	Perl_gv_init_pvn(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi, U32 flags)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_GV_INIT_PVN	\
+	assert(gv); assert(name)
+
+PERL_CALLCONV void	Perl_gv_init_sv(pTHX_ GV* gv, HV* stash, SV* namesv, int multi, U32 flags)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_GV_INIT_SV	\
+	assert(gv); assert(namesv)
+
 PERL_CALLCONV void	Perl_gv_name_set(pTHX_ GV* gv, const char *name, U32 len, U32 flags)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
@@ -5302,9 +5314,9 @@ STATIC HV*	S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
 #define PERL_ARGS_ASSERT_GV_GET_SUPER_PKG	\
 	assert(name)
 
-STATIC void	S_gv_init_sv(pTHX_ GV *gv, const svtype sv_type)
+STATIC void	S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
 			__attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_GV_INIT_SV	\
+#define PERL_ARGS_ASSERT_GV_INIT_SVTYPE	\
 	assert(gv)
 
 STATIC void	S_gv_magicalize_isa(pTHX_ GV *gv)