New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
SvPVbyte croaks before handling get magic #10116
Comments
From @ntyniThis is a bug report for perl from Niko Tyni <ntyni@debian.org> The following script croaks with 'Wide character in subroutine entry' #!perl qq[\x{263a}] =~ /(.)/ and "$1"; # vivify $1 with utf8 flag "\303\244" =~ /(.)/ and do { The exception is thrown from the SvPVbyte call in cpan/Digest-MD5/MD5.xs:726. AIUI, SvPVbyte() looks at the utf8 flag before handling get magic for I'm attaching a patch that adds a TODO test in XS-APItest for this. Originally reported by Joey Hess as http://bugs.debian.org/376329 . Flags: Site configuration information for perl 5.11.4: Configured by niko at Mon Jan 25 19:04:36 EET 2010. Summary of my perl5 (revision 5 version 11 subversion 4) configuration: Locally applied patches: @INC for perl 5.11.4: Environment for perl 5.11.4: |
From @ntyni0001-TODO-test-SvPVbyte-should-handle-get-magic-before-ch.patchFrom 8a0ae597ee3ca1671784bda0efa80ca1f22b0155 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Tue, 26 Jan 2010 21:59:45 +0200
Subject: [PATCH] TODO test: SvPVbyte should handle get magic before checking the utf8 flag
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
|
From @tonycoz
Fix for the problem exposed by the test. Meant to be applied over the Tony |
From @tonycoz0001-rt-72398-make-SvPVbyte-get-magic-before-downgra.patchFrom 0ab5f684f244dbf9c97b45de577991486d6e10e7 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Sat, 13 Mar 2010 00:45:38 +1100
Subject: [PATCH] rt #72398 - make SvPVbyte() get magic before downgrading if there's GMAGIC
---
ext/XS-APItest/t/svpv_magic.t | 3 ---
sv.c | 4 +++-
sv.h | 4 ++++
3 files changed, 7 insertions(+), 4 deletions(-)
diff --git a/ext/XS-APItest/t/svpv_magic.t b/ext/XS-APItest/t/svpv_magic.t
index dd2af8c..8be18d4 100644
--- a/ext/XS-APItest/t/svpv_magic.t
+++ b/ext/XS-APItest/t/svpv_magic.t
@@ -25,8 +25,5 @@ is(XS::APItest::first_byte("$1"), 0303,
$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");
-}
diff --git a/sv.c b/sv.c
index b6c03ed..5ebdc77 100644
--- a/sv.c
+++ b/sv.c
@@ -3075,8 +3075,10 @@ Perl_sv_2pvbyte(pTHX_ register SV *const sv, STRLEN *const lp)
{
PERL_ARGS_ASSERT_SV_2PVBYTE;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
sv_utf8_downgrade(sv,0);
- return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
+ return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
}
/*
diff --git a/sv.h b/sv.h
index fc1b475..deeb4fb 100644
--- a/sv.h
+++ b/sv.h
@@ -1560,6 +1560,10 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))
+#define SvPV_nomg_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, 0, 0))
+
#define SvPV_nolen_const(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))
--
1.5.6.5
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Sat, Mar 13, 2010 at 12:52:09AM +1100, Tony Cook wrote:
Applied the original TODO test patch by hand, and a variant of my Tony |
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#72398 (status was 'resolved')
Searchable as RT72398$
The text was updated successfully, but these errors were encountered: