X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=c0c1ef4163152791454ef41b671bb12805a19b33;hb=43d2322dfe15a2c5bb24cfb950929e9c6bfb5cdd;hp=ea64ff8fb4dab891fcfb8c56e367d092e2ab2764;hpb=fc0199cd1c85fd36bc9608790098dc15545b22a6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index ea64ff8..c0c1ef4 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. @@ -12,6 +12,11 @@ * "'So that was the job I felt I had to do when I started,' thought Sam." */ +/* This file contains some common functions needed to carry out certain + * ops. For example both pp_schomp() and pp_chomp() - scalar and array + * chomp operations - call the function do_chomp() found in this file. + */ + #include "EXTERN.h" #define PERL_IN_DOOP_C #include "perl.h" @@ -1008,6 +1013,8 @@ Perl_do_chomp(pTHX_ register SV *sv) STRLEN len; STRLEN n_a; char *s; + char *temp_buffer = NULL; + SV* svrecode = Nullsv; if (RsSNARF(PL_rs)) return 0; @@ -1043,6 +1050,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; @@ -1057,8 +1076,43 @@ 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)) { + /* RS is utf8, scalar is 8 bit. */ + bool is_utf8 = TRUE; + temp_buffer = (char*)bytes_from_utf8((U8*)rsptr, + &rslen, &is_utf8); + if (is_utf8) { + /* Cannot downgrade, therefore cannot possibly match + */ + assert (temp_buffer == rsptr); + temp_buffer = NULL; + goto nope; + } + rsptr = temp_buffer; + } + 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; + } + } if (rslen == 1) { if (*s != *rsptr) goto nope; @@ -1071,7 +1125,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); @@ -1081,6 +1135,11 @@ Perl_do_chomp(pTHX_ register SV *sv) SvSETMAGIC(sv); } nope: + + if (svrecode) + SvREFCNT_dec(svrecode); + + Safefree(temp_buffer); return count; } @@ -1112,8 +1171,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */ - lsave = lc = SvPV(left, leftlen); - rsave = rc = SvPV(right, rightlen); + lsave = lc = SvPV_nomg(left, leftlen); + rsave = rc = SvPV_nomg(right, rightlen); len = leftlen < rightlen ? leftlen : rightlen; lensave = len; if ((left_utf || right_utf) && (sv == left || sv == right)) { @@ -1122,7 +1181,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) } else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { STRLEN n_a; - dc = SvPV_force(sv, n_a); + dc = SvPV_force_nomg(sv, n_a); if (SvCUR(sv) < (STRLEN)len) { dc = SvGROW(sv, (STRLEN)(len + 1)); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);