[PATCH] TODO test: SvPVbyte should handle get magic before checking the utf8 flag

Niko Tyni ntyni at debian.org
Tue Jan 26 19:59:45 UTC 2010


When $1 had the utf8 flag set from a previous match, SvPVbyte
may croak with 'Wide character in subroutine entry' before
resetting the flag to its new value.

Add a support function and a TODO test for this in XS-APItest.

http://bugs.debian.org/376329
---
 MANIFEST                      |    1 +
 ext/XS-APItest/APItest.xs     |   12 ++++++++++++
 ext/XS-APItest/t/svpv_magic.t |   32 ++++++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+), 0 deletions(-)
 create mode 100644 ext/XS-APItest/t/svpv_magic.t

diff --git a/MANIFEST b/MANIFEST
index 17056fc..2366de9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3232,6 +3232,7 @@ ext/XS-APItest/t/printf.t	XS::APItest extension
 ext/XS-APItest/t/push.t		XS::APItest extension
 ext/XS-APItest/t/rmagical.t	XS::APItest extension
 ext/XS-APItest/t/svpeek.t	XS::APItest extension
+ext/XS-APItest/t/svpv_magic.t	Test behaviour of SvPVbyte and get magic
 ext/XS-APItest/t/svsetsv.t	Test behaviour of sv_setsv with/without PERL_CORE
 ext/XS-APItest/t/utf16_to_utf8.t	Test behaviour of utf16_to_utf8{,reversed}
 ext/XS-APItest/t/xs_special_subs_require.t	for require too
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index ede6994..41b74c8 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -936,3 +936,15 @@ void
 my_exit(int exitcode)
         PPCODE:
         my_exit(exitcode);
+
+U8
+first_byte(sv)
+	SV *sv
+   CODE:
+    char *s;
+    STRLEN len;
+	s = SvPVbyte(sv, len);
+	RETVAL = s[0];
+   OUTPUT:
+    RETVAL
+
diff --git a/ext/XS-APItest/t/svpv_magic.t b/ext/XS-APItest/t/svpv_magic.t
new file mode 100644
index 0000000..dd2af8c
--- /dev/null
+++ b/ext/XS-APItest/t/svpv_magic.t
@@ -0,0 +1,32 @@
+#!perl -w
+BEGIN {
+    require '../../t/test.pl';
+    plan(5);
+    use_ok('XS::APItest')
+};
+
+$b = "\303\244"; # or encode_utf8("\x{e4}");
+
+is(XS::APItest::first_byte($b), 0303,
+    "test function first_byte works");
+
+$b =~ /(.)/;
+is(XS::APItest::first_byte($1), 0303,
+    "matching works correctly");
+
+$a = qq[\x{263a}]; # utf8 flag is set
+
+$a =~ s/(.)/$1/;      # $1 now has the utf8 flag set too
+$b =~ /(.)/;          # $1 shouldn't have the utf8 flag anymore
+
+is(XS::APItest::first_byte("$1"), 0303,
+    "utf8 flag in match fetched correctly when stringified first");
+
+$a =~ s/(.)/$1/;      # $1 now has the utf8 flag set too
+$b =~ /(.)/;          # $1 shouldn't have the utf8 flag anymore
+
+TODO: {
+local $TODO = "SvPVbyte should handle get magic before checking the utf8 flag";
+is(eval { XS::APItest::first_byte($1) } || $@, 0303,
+    "utf8 flag fetched correctly without stringification");
+}
-- 
1.6.6


--ikeVEW9yuYc//A+q--






More information about the Perl-maintainers mailing list