Re: Copying PV only with possible UTF-8 characters

Message-ID: <3C795DB7.40105@rowman.com>

p4raw-id: //depot/perl@14857

diff --git a/embed.fnc b/embed.fnc
index fbc9099..a16b325 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1308,6 +1308,7 @@ Apd       |void   |sv_catsv_flags |SV* dsv|SV* ssv|I32 flags
 Apd    |STRLEN |sv_utf8_upgrade_flags|SV *sv|I32 flags
 Apd    |char*  |sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags
 Apd    |char*  |sv_2pv_flags   |SV* sv|STRLEN* lp|I32 flags
+Apd    |void   |sv_copypv      |SV* dsv|SV* ssv
 Ap     |char*  |my_atof2       |const char *s|NV* value
 Apn    |int    |my_socketpair  |int family|int type|int protocol|int fd[2]
 

diff --git a/embed.h b/embed.h
index d7e137a..f9bff8a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1215,6 +1215,7 @@
 #define sv_utf8_upgrade_flags  Perl_sv_utf8_upgrade_flags
 #define sv_pvn_force_flags     Perl_sv_pvn_force_flags
 #define sv_2pv_flags           Perl_sv_2pv_flags
+#define sv_copypv              Perl_sv_copypv
 #define my_atof2               Perl_my_atof2
 #define my_socketpair          Perl_my_socketpair
 #if defined(USE_PERLIO) && !defined(USE_SFIO)
@@ -2759,6 +2760,7 @@
 #define sv_utf8_upgrade_flags(a,b)     Perl_sv_utf8_upgrade_flags(aTHX_ a,b)
 #define sv_pvn_force_flags(a,b,c)      Perl_sv_pvn_force_flags(aTHX_ a,b,c)
 #define sv_2pv_flags(a,b,c)    Perl_sv_2pv_flags(aTHX_ a,b,c)
+#define sv_copypv(a,b)         Perl_sv_copypv(aTHX_ a,b)
 #define my_atof2(a,b)          Perl_my_atof2(aTHX_ a,b)
 #define my_socketpair          Perl_my_socketpair
 #if defined(USE_PERLIO) && !defined(USE_SFIO)

diff --git a/global.sym b/global.sym
index 624f356..4b5eca1 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -612,6 +612,7 @@ Perl_sv_catsv_flags
 Perl_sv_utf8_upgrade_flags
 Perl_sv_pvn_force_flags
 Perl_sv_2pv_flags
+Perl_sv_copypv
 Perl_my_atof2
 Perl_my_socketpair
 Perl_PerlIO_close

diff --git a/lib/overload.t b/lib/overload.t
index d075062..cf49eac 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1046,5 +1046,25 @@ $r = Foo->new(0);
 
 test(($r || 0) == 0); # 222
 
+package utf8_o;
+
+use overload 
+  '""'  =>  sub { return $_[0]->{var}; }
+  ;
+  
+sub new
+  {
+    my $class = shift;
+    my $self =  {};
+    $self->{var} = shift;
+    bless $self,$class;
+  }
+
+package main;
+
+
+my $utfvar = new utf8_o 200.2.1;
+test("$utfvar" eq 200.2.1); # 223
+
 # Last test is:
-sub last {222}
+sub last {223}

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index af5bf36..487a882 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -646,6 +646,32 @@ Found in file perl.c
 
 =back
 
+=head1 Functions in file pp_pack.c
+
+
+=over 8
+
+=item pack_cat
+
+The engine implementing pack() Perl function.
+
+       void    pack_cat(SV *cat, char *pat, char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
+
+=for hackers
+Found in file pp_pack.c
+
+=item unpack_str
+
+The engine implementing unpack() Perl function.
+
+       I32     unpack_str(char *pat, char *patend, char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags)
+
+=for hackers
+Found in file pp_pack.c
+
+
+=back
+
 =head1 Global Variables
 
 =over 8
@@ -2869,21 +2895,21 @@ Like C<SvPV_nolen>, but converts sv to utf8 first if necessary.
 =for hackers
 Found in file sv.h
 
-=item SvPVX
+=item SvPVx
 
-Returns a pointer to the physical string in the SV.  The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
 
-       char*   SvPVX(SV* sv)
+       char*   SvPVx(SV* sv, STRLEN len)
 
 =for hackers
 Found in file sv.h
 
-=item SvPVx
+=item SvPVX
 
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV.  The SV must contain a
+string.
 
-       char*   SvPVx(SV* sv, STRLEN len)
+       char*   SvPVX(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -3483,6 +3509,21 @@ settings.
 =for hackers
 Found in file sv.c
 
+=item sv_copypv
+
+Copies a stringified representation of the source SV into the
+destination SV.  Automatically performs any necessary mg_get and
+coercion of numeric values into strings.  Guaranteed to preserve 
+UTF-8 flag even from overloaded objects.  Similar in nature to
+sv_2pv[_flags] but operates directly on an SV instead of just the 
+string.  Mostly uses sv_2pv_flags to do its work, except when that 
+would lose the UTF-8'ness of the PV.
+
+       void    sv_copypv(SV* dsv, SV* ssv)
+
+=for hackers
+Found in file sv.c
+
 =item sv_dec
 
 Auto-decrement of the value in the SV, doing string to numeric conversion

diff --git a/pp_hot.c b/pp_hot.c
index 1d2dffa..516212d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -72,14 +72,7 @@ PP(pp_pushmark)
 PP(pp_stringify)
 {
     dSP; dTARGET;
-    STRLEN len;
-    char *s;
-    s = SvPV(TOPs,len);
-    sv_setpvn(TARG,s,len);
-    if (SvUTF8(TOPs))
-       SvUTF8_on(TARG);
-    else
-       SvUTF8_off(TARG);
+    sv_copypv(TARG,TOPs);
     SETTARG;
     RETURN;
 }

diff --git a/proto.h b/proto.h
index 3de4e0a..64de705 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1340,6 +1340,7 @@ PERL_CALLCONV void        Perl_sv_catsv_flags(pTHX_ SV* dsv, SV* ssv, I32 flags);
 PERL_CALLCONV STRLEN   Perl_sv_utf8_upgrade_flags(pTHX_ SV *sv, I32 flags);
 PERL_CALLCONV char*    Perl_sv_pvn_force_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags);
 PERL_CALLCONV char*    Perl_sv_2pv_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags);
+PERL_CALLCONV void     Perl_sv_copypv(pTHX_ SV* dsv, SV* ssv);
 PERL_CALLCONV char*    Perl_my_atof2(pTHX_ const char *s, NV* value);
 PERL_CALLCONV int      Perl_my_socketpair(int family, int type, int protocol, int fd[2]);
 

diff --git a/sv.c b/sv.c
index 89c6e20..376418b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3148,6 +3148,43 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 }
 
 /*
+=for apidoc sv_copypv
+
+Copies a stringified representation of the source SV into the
+destination SV.  Automatically performs any necessary mg_get and
+coercion of numeric values into strings.  Guaranteed to preserve 
+UTF-8 flag even from overloaded objects.  Similar in nature to
+sv_2pv[_flags] but operates directly on an SV instead of just the 
+string.  Mostly uses sv_2pv_flags to do its work, except when that 
+would lose the UTF-8'ness of the PV.
+
+=cut
+*/
+
+void
+Perl_sv_copypv(pTHX_ SV *dsv, register SV *ssv)
+{
+    SV *tmpsv = sv_newmortal();
+
+    if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) ) {
+       tmpsv=AMG_CALLun(ssv,string);
+       if (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(ssv)))
+           return SvSetSV(dsv,tmpsv);
+    }
+    {
+       STRLEN len;
+       char *s;
+       s = SvPV(ssv,len);
+       sv_setpvn(tmpsv,s,len);
+       if (SvUTF8(ssv))
+           SvUTF8_on(tmpsv);
+       else
+           SvUTF8_off(tmpsv);
+       return SvSetSV(dsv,tmpsv);
+    }
+}
+
+/*
 =for apidoc sv_2pvbyte_nolen
 
 Return a pointer to the byte-encoded representation of the SV.