Make SvPVbyte work on tied non-PV
authorFather Chrysostomos <sprout@cpan.org>
Sat, 10 Aug 2013 11:48:17 +0000 (04:48 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 14:54:18 +0000 (07:54 -0700)
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.

ext/XS-APItest/t/svpv.t
sv.c

index 914b585..4602891 100644 (file)
@@ -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';
diff --git a/sv.c b/sv.c
index 44842fe..198ae73 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);
 }