From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 18 Oct 2014 05:32:23 +0000 (-0700)
Subject: Apify SV_CATBYTES and SV_CATUTF8
X-Git-Tag: v5.21.5~54^2~2
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/20c88bf7facccf1de86d055e8b89eacf898319a4

Apify SV_CATBYTES and SV_CATUTF8

When I added them I was not sure at the time whether they would be
stable or whether they might need to be changed.  They seem pretty
stable now, and they are extremely useful, so make them part
of the API.
---

diff --git a/MANIFEST b/MANIFEST
index 25c3d8c..31c59fe 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3858,6 +3858,7 @@ ext/XS-APItest/t/stmtsasexpr.t	test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t	test for eval side-effecting source string
 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/svcat.t	Test sv_catpvn
 ext/XS-APItest/t/sviscow.t	Test SvIsCOW
 ext/XS-APItest/t/svpeek.t	XS::APItest extension
 ext/XS-APItest/t/svpv_magic.t	Test behaviour of SvPVbyte/utf8 & get magic
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 1c4428a..da7bcee 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3600,6 +3600,15 @@ cv_name(SVREF ref, ...)
     OUTPUT:
 	RETVAL
 
+void
+sv_catpvn(SV *sv, SV *sv2)
+    CODE:
+    {
+	STRLEN len;
+	const char *s = SvPV(sv2,len);
+	sv_catpvn_flags(sv,s,len, SvUTF8(sv2) ? SV_CATUTF8 : SV_CATBYTES);
+    }
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
diff --git a/ext/XS-APItest/t/svcat.t b/ext/XS-APItest/t/svcat.t
new file mode 100644
index 0000000..843841c
--- /dev/null
+++ b/ext/XS-APItest/t/svcat.t
@@ -0,0 +1,18 @@
+#!perl
+
+use Test::More tests => 4;
+use XS::APItest;
+use utf8;
+
+$_ = "καλοκαίρι";
+sv_catpvn($_, " \xe9t\xe9"); # uses SV_CATBYTES
+is $_, "καλοκαίρι été", 'sv_catpvn_flags(utfsv, ... SV_CATBYTES)';
+$_ = "\xe9t\xe9";
+sv_catpvn($_, " καλοκαίρι"); # uses SV_CATUTF8
+is $_, "été καλοκαίρι", 'sv_catpvn_flags(bytesv, ... SV_CATUTF8)';
+$_ = "καλοκαίρι";
+sv_catpvn($_, " été"); # uses SV_CATUTF8
+is $_, "καλοκαίρι été", 'sv_catpvn_flags(utfsv, ... SV_CATUTF8)';
+$_ = "\xe9t\xe9";
+sv_catpvn($_, " \xe9t\xe9"); # uses SV_CATBYTES
+is $_, "été été", 'sv_catpvn_flags(bytesv, ... SV_CATBYTES)';
diff --git a/sv.c b/sv.c
index cd77099..8f46c19 100644
--- a/sv.c
+++ b/sv.c
@@ -5387,8 +5387,14 @@ Handles 'get' magic, but not 'set' magic.  See C<sv_catpvn_mg>.
 =for apidoc sv_catpvn_flags
 
 Concatenates the string onto the end of the string which is in the SV.  The
-C<len> indicates number of bytes to copy.  If the SV has the UTF-8
-status set, then the bytes appended should be valid UTF-8.
+C<len> indicates number of bytes to copy.
+
+By default, the string appended is assumed to be valid UTF-8 if the SV has
+the UTF-8 status set, and a string of bytes otherwise.  One can force the
+appended string to be interpreted as UTF-8 by supplying the C<SV_CATUTF8>
+flag, and as bytes by supplying the C<SV_CATBYTES> flag; the SV or the
+string appended will be upgraded to UTF-8 if necessary.
+
 If C<flags> has the C<SV_SMAGIC> bit set, will
 C<mg_set> on C<dsv> afterwards if appropriate.
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
diff --git a/sv.h b/sv.h
index 8c751dc..06fd27a 100644
--- a/sv.h
+++ b/sv.h
@@ -1871,12 +1871,8 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>.
 /* if (after resolving magic etc), the SV is found to be overloaded,
  * don't call the overload magic, just return as-is */
 #define SV_SKIP_OVERLOAD	8192
-/* It is not yet clear whether we want this as an API, or what the
- * constants should be named. */
-#ifdef PERL_CORE
-# define SV_CATBYTES		16384
-# define SV_CATUTF8		32768
-#endif
+#define SV_CATBYTES		16384
+#define SV_CATUTF8		32768
 
 /* The core is safe for this COW optimisation. XS code on CPAN may not be.
    So only default to doing the COW setup if we're in the core.