[perl #108994] Stop SvPVutf8 from coercing SVs

In shouldn’t destroy globs or references passed to it, or try to
coerce them if they are read-only or incoercible.

I added tests for SvPVbyte at the same time, even though it was not
exhibiting the same problems, as sv_utf8_downgrade doesn’t try to
coerce anything.  (SvPVbyte has its own set of bugs, which I hope to
fix in fifthcoming commits.)

2 files changed, 33 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 01b5b087f8..2c20ec2fab 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3273,6 +3273,20 @@ CODE:
 OUTPUT:
     RETVAL
 
+char *
+SvPVbyte(SV *sv)
+CODE:
+    RETVAL = SvPVbyte_nolen(sv);
+OUTPUT:
+    RETVAL
+
+char *
+SvPVutf8(SV *sv)
+CODE:
+    RETVAL = SvPVutf8_nolen(sv);
+OUTPUT:
+    RETVAL
+
 
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
diff --git a/ext/XS-APItest/t/svpv.t b/ext/XS-APItest/t/svpv.t
new file mode 100644
index 0000000000..e98df08486
--- /dev/null
+++ b/ext/XS-APItest/t/svpv.t
@@ -0,0 +1,19 @@
+#!perl -w
+
+use Test::More tests => 16;
+
+use XS::APItest;
+
+for my $func ('SvPVbyte', 'SvPVutf8') {
+ $g = *glob;
+ $r = \1;
+ is &$func($g), '*main::glob', "$func(\$glob_copy)";
+ is ref\$g, 'GLOB', "$func(\$glob_copy) does not flatten the glob";
+ is &$func($r), "$r", "$func(\$ref)";
+ is ref\$r, 'REF', "$func(\$ref) does not flatten the ref";
+
+ is &$func(*glob), '*main::glob', "$func(*glob)";
+ is ref\$::{glob}, 'GLOB', "$func(*glob) does not flatten the glob";
+ is &$func($^V), "$^V", "$func(\$ro_ref)";
+ is ref\$^V, 'REF', "$func(\$ro_ref) does not flatten the ref";
+}