From: John Peacock Date: Sun, 24 Feb 2002 16:40:07 +0000 (-0500) Subject: Re: Copying PV only with possible UTF-8 characters X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6050d10e6008e3d6e86de76c85d93bf5c06336aa;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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, 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 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 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 --- 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 --- 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 --- 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.