From: Nicholas Clark Date: Mon, 7 Nov 2005 14:05:25 +0000 (+0000) Subject: The rarely used lcfirst and ucfirst share almost all their code. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12e9c124f1a94b176ea78903408ad28f79c267c6;p=p5sagit%2Fp5-mst-13.2.git The rarely used lcfirst and ucfirst share almost all their code. Merge the two as pp_ucfirst. p4raw-id: //depot/perl@26035 --- diff --git a/mathoms.c b/mathoms.c index 943220d..c0fc740 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1015,6 +1015,11 @@ PP(pp_dorassign) return pp_defined(); } +PP(pp_lcfirst) +{ + return pp_ucfirst(); +} + U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) { diff --git a/opcode.h b/opcode.h index 1d10059..0086001 100644 --- a/opcode.h +++ b/opcode.h @@ -887,7 +887,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_pp_chr), MEMBER_TO_FPTR(Perl_pp_crypt), MEMBER_TO_FPTR(Perl_pp_ucfirst), - MEMBER_TO_FPTR(Perl_pp_lcfirst), + MEMBER_TO_FPTR(Perl_pp_ucfirst), /* Perl_pp_lcfirst */ MEMBER_TO_FPTR(Perl_pp_uc), MEMBER_TO_FPTR(Perl_pp_lc), MEMBER_TO_FPTR(Perl_pp_quotemeta), diff --git a/opcode.pl b/opcode.pl index 4582b9b..0c1026d 100755 --- a/opcode.pl +++ b/opcode.pl @@ -76,6 +76,7 @@ my @raw_alias = ( Perl_pp_defined => [qw(dor dorassign)], Perl_pp_and => ['andassign'], Perl_pp_or => ['orassign'], + Perl_pp_ucfirst => ['lcfirst'], ); while (my ($func, $names) = splice @raw_alias, 0, 2) { diff --git a/pp.c b/pp.c index 53ddb0c..8d34510 100644 --- a/pp.c +++ b/pp.c @@ -3381,6 +3381,7 @@ PP(pp_ucfirst) SV *sv = TOPs; const U8 *s; STRLEN slen; + const int op_type = PL_op->op_type; SvGETMAGIC(sv); if (DO_UTF8(sv) && @@ -3391,17 +3392,21 @@ PP(pp_ucfirst) STRLEN tculen; utf8_to_uvchr(s, &ulen); - toTITLE_utf8(s, tmpbuf, &tculen); + if (op_type == OP_UCFIRST) { + toTITLE_utf8(s, tmpbuf, &tculen); + } else { + toLOWER_utf8(s, tmpbuf, &tculen); + } if (!SvPADTMP(sv) || SvREADONLY(sv) || ulen != tculen) { dTARGET; /* slen is the byte length of the whole SV. * ulen is the byte length of the original Unicode character * stored as UTF-8 at s. - * tculen is the byte length of the freshly titlecased - * Unicode character stored as UTF-8 at tmpbuf. - * We first set the result to be the titlecased character, - * and then append the rest of the SV data. */ + * tculen is the byte length of the freshly titlecased (or + * lowercased) Unicode character stored as UTF-8 at tmpbuf. + * We first set the result to be the titlecased (/lowercased) + * character, and then append the rest of the SV data. */ sv_setpvn(TARG, (char*)tmpbuf, tculen); if (slen > ulen) sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -3427,65 +3432,11 @@ PP(pp_ucfirst) if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); - *s1 = toUPPER_LC(*s1); - } - else - *s1 = toUPPER(*s1); - } - } - SvSETMAGIC(sv); - RETURN; -} - -PP(pp_lcfirst) -{ - dSP; - SV *sv = TOPs; - const U8 *s; - STRLEN slen; - - SvGETMAGIC(sv); - if (DO_UTF8(sv) && - (s = (const U8*)SvPV_nomg_const(sv, slen)) && slen && - UTF8_IS_START(*s)) { - STRLEN ulen; - STRLEN lculen; - U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; - - utf8_to_uvchr(s, &ulen); - toLOWER_utf8(s, tmpbuf, &lculen); - - if (!SvPADTMP(sv) || SvREADONLY(sv) || ulen != lculen) { - dTARGET; - sv_setpvn(TARG, (char*)tmpbuf, lculen); - if (slen > ulen) - sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); - SvUTF8_on(TARG); - SETs(TARG); - } - else { - s = (U8*)SvPV_force_nomg(sv, slen); - Copy(tmpbuf, s, ulen, U8); - } - } - else { - U8 *s1; - if (!SvPADTMP(sv) || SvREADONLY(sv)) { - dTARGET; - SvUTF8_off(TARG); /* decontaminate */ - sv_setsv_nomg(TARG, sv); - sv = TARG; - SETs(sv); - } - s1 = (U8*)SvPV_force_nomg(sv, slen); - if (*s1) { - if (IN_LOCALE_RUNTIME) { - TAINT; - SvTAINTED_on(sv); - *s1 = toLOWER_LC(*s1); + *s1 = (op_type == OP_UCFIRST) + ? toUPPER_LC(*s1) : toLOWER_LC(*s1); } else - *s1 = toLOWER(*s1); + *s1 = (op_type == OP_UCFIRST) ? toUPPER(*s1) : toLOWER(*s1); } } SvSETMAGIC(sv);