X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=73b05f5780192bb40a25d3c2440626bbc6be47e2;hb=66e2fd5444a96049971bab49da0a163e8fa5e52d;hp=47d64cb9f22d787c7cd8b74f930a57317352e6a3;hpb=891f9566d7fc0fb068ade9d98aed69773e02d39c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index 47d64cb..73b05f5 100644 --- a/doop.c +++ b/doop.c @@ -1,7 +1,7 @@ /* doop.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, by Larry Wall and others + * 2000, 2001, 2002, 2004, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -1009,6 +1009,7 @@ Perl_do_chomp(pTHX_ register SV *sv) STRLEN n_a; char *s; char *temp_buffer = NULL; + SV* svrecode = Nullsv; if (RsSNARF(PL_rs)) return 0; @@ -1044,6 +1045,18 @@ Perl_do_chomp(pTHX_ register SV *sv) if (SvREADONLY(sv)) Perl_croak(aTHX_ PL_no_modify); } + + if (PL_encoding) { + if (!SvUTF8(sv)) { + /* XXX, here sv is utf8-ized as a side-effect! + If encoding.pm is used properly, almost string-generating + operations, including literal strings, chr(), input data, etc. + should have been utf8-ized already, right? + */ + sv_recode_to_utf8(sv, PL_encoding); + } + } + s = SvPV(sv, len); if (s && len) { s += --len; @@ -1058,8 +1071,13 @@ Perl_do_chomp(pTHX_ register SV *sv) } } else { - STRLEN rslen; + STRLEN rslen, rs_charlen; char *rsptr = SvPV(PL_rs, rslen); + + rs_charlen = SvUTF8(PL_rs) + ? sv_len_utf8(PL_rs) + : rslen; + if (SvUTF8(PL_rs) != SvUTF8(sv)) { /* Assumption is that rs is shorter than the scalar. */ if (SvUTF8(PL_rs)) { @@ -1075,7 +1093,16 @@ Perl_do_chomp(pTHX_ register SV *sv) goto nope; } rsptr = temp_buffer; - } else { + } + else if (PL_encoding) { + /* RS is 8 bit, encoding.pm is used. + * Do not recode PL_rs as a side-effect. */ + svrecode = newSVpvn(rsptr, rslen); + sv_recode_to_utf8(svrecode, PL_encoding); + rsptr = SvPV(svrecode, rslen); + rs_charlen = sv_len_utf8(svrecode); + } + else { /* RS is 8 bit, scalar is utf8. */ temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen); rsptr = temp_buffer; @@ -1093,7 +1120,7 @@ Perl_do_chomp(pTHX_ register SV *sv) s -= rslen - 1; if (memNE(s, rsptr, rslen)) goto nope; - count += rslen; + count += rs_charlen; } } s = SvPV_force(sv, n_a); @@ -1103,6 +1130,10 @@ Perl_do_chomp(pTHX_ register SV *sv) SvSETMAGIC(sv); } nope: + + if (svrecode) + SvREFCNT_dec(svrecode); + Safefree(temp_buffer); return count; }