Create sv_streq() API family, as a stringy copy of the sv_numeq() ones

MANIFEST

@@ -4643,6 +4643,7 @@ ext/XS-APItest/t/stuff_svcur_bug.t	test for a bug in lex_stuff_pvn
 ext/XS-APItest/t/subcall.t	Test XSUB calls
 ext/XS-APItest/t/subsignature.t	Test parse_subsignature()
 ext/XS-APItest/t/sv_numeq.t	Test sv_numeq
+ext/XS-APItest/t/sv_streq.t	Test sv_streq
 ext/XS-APItest/t/svcat.t	Test sv_catpvn
 ext/XS-APItest/t/svcatpvf.t	Test sv_catpvf argument reordering
 ext/XS-APItest/t/sviscow.t	Test SvIsCOW

embed.fnc

@@ -1937,6 +1937,8 @@ Apd	|void	|sv_setrv_inc	|NN SV *const sv|NN SV *const ref
 Apd	|void	|sv_setrv_noinc_mg	|NN SV *const sv|NN SV *const ref
 Apd	|void	|sv_setrv_inc_mg	|NN SV *const sv|NN SV *const ref
 ApMdb	|void	|sv_setsv	|NN SV *dsv|NULLOK SV *ssv
+Amd	|bool	|sv_streq	|NULLOK SV* sv1|NULLOK SV* sv2
+Apd	|bool	|sv_streq_flags	|NULLOK SV* sv1|NULLOK SV* sv2|const U32 flags
 CpMdb	|void	|sv_taint	|NN SV* sv
 CpdR	|bool	|sv_tainted	|NN SV *const sv
 Apd	|int	|sv_unmagic	|NN SV *const sv|const int type

embed.h

@@ -707,6 +707,7 @@
 #define sv_setsv_mg(a,b)	Perl_sv_setsv_mg(aTHX_ a,b)
 #define sv_setuv(a,b)		Perl_sv_setuv(aTHX_ a,b)
 #define sv_setuv_mg(a,b)	Perl_sv_setuv_mg(aTHX_ a,b)
+#define sv_streq_flags(a,b,c)	Perl_sv_streq_flags(aTHX_ a,b,c)
 #define sv_string_from_errnum(a,b)	Perl_sv_string_from_errnum(aTHX_ a,b)
 #define sv_tainted(a)		Perl_sv_tainted(aTHX_ a)
 #define sv_true(a)		Perl_sv_true(aTHX_ a)

ext/XS-APItest/APItest.xs

@@ -4591,6 +4591,20 @@ sv_numeq_flags(SV *sv1, SV *sv2, U32 flags)
     OUTPUT:
         RETVAL
 
+bool
+sv_streq(SV *sv1, SV *sv2)
+    CODE:
+        RETVAL = sv_streq(sv1, sv2);
+    OUTPUT:
+        RETVAL
+
+bool
+sv_streq_flags(SV *sv1, SV *sv2, U32 flags)
+    CODE:
+        RETVAL = sv_streq_flags(sv1, sv2, flags);
+    OUTPUT:
+        RETVAL
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int

ext/XS-APItest/t/sv_streq.t

@@ -0,0 +1,29 @@
+#!perl
+
+use Test::More tests => 7;
+use XS::APItest;
+
+my $abc = "abc";
+ok  sv_streq($abc, "abc"), '$abc eq "abc"';
+ok !sv_streq($abc, "def"), '$abc ne "def"';
+
+# consider also UTF-8 vs not
+
+# GMAGIC
+"ABC" =~ m/(\w+)/;
+ok !sv_streq_flags($1, "ABC", 0), 'sv_streq_flags with no flags does not GETMAGIC';
+ok  sv_streq_flags($1, "ABC", SV_GMAGIC), 'sv_streq_flags with SV_GMAGIC does';
+
+# overloading
+{
+    package AlwaysABC {
+        use overload
+            'eq' => sub { return $_[1] eq "ABC" },
+            '""' => sub { "not-a-string" };
+    }
+
+    ok  sv_streq(bless([], "AlwaysABC"), "ABC"), 'AlwaysABC is "ABC"';
+    ok !sv_streq(bless([], "AlwaysABC"), "DEF"), 'AlwaysABC is not "DEF"';
+
+    ok !sv_streq_flags(bless([], "AlwaysABC"), "ABC", SV_SKIP_OVERLOAD), 'AlwaysABC is not "ABC" with SV_SKIP_OVERLOAD';
+}

proto.h

@@ -3865,6 +3865,10 @@ PERL_CALLCONV void	Perl_sv_setuv(pTHX_ SV *const sv, const UV num);
 PERL_CALLCONV void	Perl_sv_setuv_mg(pTHX_ SV *const sv, const UV u);
 #define PERL_ARGS_ASSERT_SV_SETUV_MG	\
 	assert(sv)
+/* PERL_CALLCONV bool	sv_streq(pTHX_ SV* sv1, SV* sv2); */
+#define PERL_ARGS_ASSERT_SV_STREQ
+PERL_CALLCONV bool	Perl_sv_streq_flags(pTHX_ SV* sv1, SV* sv2, const U32 flags);
+#define PERL_ARGS_ASSERT_SV_STREQ_FLAGS
 PERL_CALLCONV SV*	Perl_sv_string_from_errnum(pTHX_ int errnum, SV* tgtsv);
 #define PERL_ARGS_ASSERT_SV_STRING_FROM_ERRNUM
 #ifndef NO_MATHOMS

sv.c

@@ -8179,6 +8179,54 @@ Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
         return 0;
 }
 
+/*
+=for apidoc sv_streq_flags
+
+Returns a boolean indicating whether the strings in the two SVs are
+identical. If the flags has the C<SV_GMAGIC> bit set, it handles
+get-magic too. Will coerce its args to strings if necessary. Treats
+C<NULL> as undef.
+
+If flags does not have the C<SV_SKIP_OVERLOAD> set, an attempt to use C<eq>
+overloading will be made. If such overloading does not exist or the flag is
+set, then regular string comparison will be used instead.
+
+=for apidoc sv_streq
+
+A convenient shortcut for calling C<sv_streq_flags> with the C<SV_GMAGIC>
+flag.
+
+=cut
+*/
+
+bool
+Perl_sv_streq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
+{
+    PERL_ARGS_ASSERT_SV_STREQ_FLAGS;
+
+    if(flags & SV_GMAGIC) {
+        if(sv1)
+            SvGETMAGIC(sv1);
+        if(sv2)
+            SvGETMAGIC(sv2);
+    }
+
+    /* Treat NULL as undef */
+    if(!sv1)
+        sv1 = &PL_sv_undef;
+    if(!sv2)
+        sv2 = &PL_sv_undef;
+
+    if(!(flags & SV_SKIP_OVERLOAD) &&
+            (SvAMAGIC(sv1) || SvAMAGIC(sv2))) {
+        SV *ret = amagic_call(sv1, sv2, seq_amg, 0);
+        if(ret)
+            return SvTRUE(ret);
+    }
+
+    return sv_eq_flags(sv1, sv2, 0);
+}
+
 /*
 =for apidoc sv_numeq_flags
 

sv.h

@@ -2160,6 +2160,7 @@ Returns the hash for C<sv> created by C<L</newSVpvn_share>>.
 #define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
 #define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
 #define sv_numeq(sv1, sv2) sv_numeq_flags(sv1, sv2, SV_GMAGIC)
+#define sv_streq(sv1, sv2) sv_streq_flags(sv1, sv2, SV_GMAGIC)
 #define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)
 #define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
 #define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0)