Make SvPVbyte return bytes for non-PVs
authorFather Chrysostomos <sprout@cpan.org>
Wed, 1 Feb 2012 02:16:48 +0000 (18:16 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 1 Feb 2012 02:16:48 +0000 (18:16 -0800)
Instead of just doing SvPV on something that is not a PV, SvPVbyte
should actually do what it is advertised as doing.

embed.fnc
ext/XS-APItest/t/svpv.t
proto.h
sv.c

index 19b6b6b..986c893 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1212,7 +1212,7 @@ pMd       |SV*    |sv_2num        |NN SV *const sv
 Amb    |char*  |sv_2pv         |NULLOK SV *sv|NULLOK STRLEN *lp
 Apd    |char*  |sv_2pv_flags   |NULLOK SV *const sv|NULLOK STRLEN *const lp|const I32 flags
 Apd    |char*  |sv_2pvutf8     |NN SV *sv|NULLOK STRLEN *const lp
-Apd    |char*  |sv_2pvbyte     |NN SV *const sv|NULLOK STRLEN *const lp
+Apd    |char*  |sv_2pvbyte     |NN SV *sv|NULLOK STRLEN *const lp
 Ap     |char*  |sv_pvn_nomg    |NN SV* sv|NULLOK STRLEN* lp
 Amb    |UV     |sv_2uv         |NULLOK SV *sv
 Apd    |UV     |sv_2uv_flags   |NULLOK SV *const sv|const I32 flags
index e98df08..914b585 100644 (file)
@@ -1,6 +1,6 @@
 #!perl -w
 
-use Test::More tests => 16;
+use Test::More tests => 18;
 
 use XS::APItest;
 
@@ -17,3 +17,9 @@ for my $func ('SvPVbyte', 'SvPVutf8') {
  is &$func($^V), "$^V", "$func(\$ro_ref)";
  is ref\$^V, 'REF', "$func(\$ro_ref) does not flatten the ref";
 }
+
+eval 'SvPVbyte(*{chr 256})';
+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';
diff --git a/proto.h b/proto.h
index 4f95c42..528f0a7 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3716,7 +3716,7 @@ PERL_CALLCONV char*       Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, cons
 #define PERL_ARGS_ASSERT_SV_2PV_NOLEN  \
        assert(sv)
 
-PERL_CALLCONV char*    Perl_sv_2pvbyte(pTHX_ SV *const sv, STRLEN *const lp)
+PERL_CALLCONV char*    Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SV_2PVBYTE    \
        assert(sv)
diff --git a/sv.c b/sv.c
index 4b37aab..f53ad12 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3029,11 +3029,16 @@ Usually accessed via the C<SvPVbyte> macro.
 */
 
 char *
-Perl_sv_2pvbyte(pTHX_ register SV *const sv, STRLEN *const lp)
+Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
-    SvGETMAGIC(sv);
+    if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv)) {
+       SV *sv2 = sv_newmortal();
+       sv_copypv(sv2,sv);
+       sv = sv2;
+    }
+    else SvGETMAGIC(sv);
     sv_utf8_downgrade(sv,0);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }