diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-08-10 04:48:17 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2013-08-11 07:54:18 -0700 |
commit | 48120f8fb3801512144143e22a9f264d9ceab915 (patch) | |
tree | 107ab511bdbe8cbc2bc45b838722ee6dfd6696a6 | |
parent | 3b68edc939ddd9cc726846b877988b10939715ab (diff) | |
download | perl-48120f8fb3801512144143e22a9f264d9ceab915.tar.gz |
Make SvPVbyte work on tied non-PV
The magic check came too late. sv_utf8_downgrade does nothing if the
argument is not a PV.
So in the test added to svpv.t the returned string was in utf8,
not bytes.
-rw-r--r-- | ext/XS-APItest/t/svpv.t | 8 | ||||
-rw-r--r-- | sv.c | 4 |
2 files changed, 9 insertions, 3 deletions
diff --git a/ext/XS-APItest/t/svpv.t b/ext/XS-APItest/t/svpv.t index 914b585075..4602891405 100644 --- a/ext/XS-APItest/t/svpv.t +++ b/ext/XS-APItest/t/svpv.t @@ -1,6 +1,6 @@ #!perl -w -use Test::More tests => 18; +use Test::More tests => 19; use XS::APItest; @@ -23,3 +23,9 @@ like $@, qr/^Wide character/, 'SvPVbyte fails on Unicode glob'; package r { use overload '""' => sub { substr "\x{100}\xff", -1 } } is SvPVbyte(bless [], r::), "\xff", 'SvPVbyte on ref returning downgradable utf8 string'; + +sub TIESCALAR { bless \(my $thing = pop), shift } +sub FETCH { ${ +shift } } +tie $tyre, main => bless [], r::; +is SvPVbyte($tyre), "\xff", + 'SvPVbyte on tie returning ref that returns downgradable utf8 string'; @@ -3082,13 +3082,13 @@ Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp) { PERL_ARGS_ASSERT_SV_2PVBYTE; + SvGETMAGIC(sv); if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv)) || isGV_with_GP(sv) || SvROK(sv)) { SV *sv2 = sv_newmortal(); - sv_copypv(sv2,sv); + sv_copypv_nomg(sv2,sv); sv = sv2; } - else SvGETMAGIC(sv); sv_utf8_downgrade(sv,0); return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv); } |