TODO test: SvPVbyte should handle get magic before checking the utf8 flag
authorNiko Tyni <ntyni@debian.org>
Mon, 25 Oct 2010 11:37:49 +0000 (22:37 +1100)
committerTony Cook <tony@develop-help.com>
Mon, 25 Oct 2010 11:57:54 +0000 (22:57 +1100)
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
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/svpv_magic.t [new file with mode: 0644]

index 85fc712..31bf3e8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3423,6 +3423,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/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/swaptwostmts.t        test recursive descent statement parsing
 ext/XS-APItest/t/temp_lv_sub.t XS::APItest: tests for lvalue subs returning temps
index e40785c..0ff2ed1 100644 (file)
@@ -1710,6 +1710,17 @@ 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
+
 I32
 sv_count()
         CODE:
diff --git a/ext/XS-APItest/t/svpv_magic.t b/ext/XS-APItest/t/svpv_magic.t
new file mode 100644 (file)
index 0000000..dd2af8c
--- /dev/null
@@ -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");
+}