Re: Copying PV only with possible UTF-8 characters

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

p4raw-id: //depot/perl@14857

8 files changed, 112 insertions, 16 deletions

diff --git a/embed.fnc b/embed.fnc
index fbc9099298..a16b325c76 100644
--- 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 d7e137a35e..f9bff8a26d 100644
--- 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 624f356da3..4b5eca17d6 100644
--- 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 d07506261d..cf49eac45a 100644
--- 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 af5bf36a24..487a882089 100644
--- 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 1d2dffa592..516212d7d3 100644
--- 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 3de4e0a54a..64de7056db 100644
--- 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 89c6e20235..376418b8ff 100644
--- 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.