X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=c43ecb111c80230930058ea50f6767b6edb0917d;hb=e54740d08a4224ce04c9347659db052ec0be5634;hp=8bff60aa0a1a3ebdcb9507e9ec25de65d4ebba35;hpb=1e968d83d8ff249abd1f06a7f900eea6b8c3fc51;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index 8bff60a..c43ecb1 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, 2004, 2005, 2006, 2007, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + * 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 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. @@ -9,7 +9,9 @@ */ /* - * "'So that was the job I felt I had to do when I started,' thought Sam." + * 'So that was the job I felt I had to do when I started,' thought Sam. + * + * [p.934 of _The Lord of the Rings_, VI/iii: "Mount Doom"] */ /* This file contains some common functions needed to carry out certain @@ -201,10 +203,6 @@ S_do_trans_complex(pTHX_ SV * const sv) if (complement && !del) rlen = tbl[0x100]; -#ifdef MACOS_TRADITIONAL -#define comp CoMP /* "comp" is a keyword in some compilers ... */ -#endif - if (PL_op->op_private & OPpTRANS_SQUASH) { UV pch = 0xfeedface; while (s < send) { @@ -316,9 +314,9 @@ S_do_trans_simple_utf8(pTHX_ SV * const sv) #ifdef USE_ITHREADS PAD_SVl(cPADOP->op_padix); #else - (SV*)cSVOP->op_sv; + MUTABLE_SV(cSVOP->op_sv); #endif - HV* const hv = (HV*)SvRV(rv); + HV* const hv = MUTABLE_HV(SvRV(rv)); SV* const * svp = hv_fetchs(hv, "NONE", FALSE); const UV none = svp ? SvUV(*svp) : 0x7fffffff; const UV extra = none + 1; @@ -418,9 +416,9 @@ S_do_trans_count_utf8(pTHX_ SV * const sv) #ifdef USE_ITHREADS PAD_SVl(cPADOP->op_padix); #else - (SV*)cSVOP->op_sv; + MUTABLE_SV(cSVOP->op_sv); #endif - HV* const hv = (HV*)SvRV(rv); + HV* const hv = MUTABLE_HV(SvRV(rv)); SV* const * const svp = hv_fetchs(hv, "NONE", FALSE); const UV none = svp ? SvUV(*svp) : 0x7fffffff; const UV extra = none + 1; @@ -469,9 +467,9 @@ S_do_trans_complex_utf8(pTHX_ SV * const sv) #ifdef USE_ITHREADS PAD_SVl(cPADOP->op_padix); #else - (SV*)cSVOP->op_sv; + MUTABLE_SV(cSVOP->op_sv); #endif - HV * const hv = (HV*)SvRV(rv); + HV * const hv = MUTABLE_HV(SvRV(rv)); SV * const *svp = hv_fetchs(hv, "NONE", FALSE); const UV none = svp ? SvUV(*svp) : 0x7fffffff; const UV extra = none + 1; @@ -637,7 +635,7 @@ Perl_do_trans(pTHX_ SV *sv) if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0); if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + Perl_croak(aTHX_ "%s", PL_no_modify); } (void)SvPV_const(sv, len); if (!len) @@ -707,7 +705,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *delim, register SV **mark, register SV * ++mark; } - sv_setpvn(sv, "", 0); + sv_setpvs(sv, ""); /* sv_setpv retains old UTF8ness [perl #24846] */ SvUTF8_off(sv); @@ -809,9 +807,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) } #ifdef UV_IS_QUAD else if (size == 64) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); if (uoffset >= srclen) retnum = 0; else if (uoffset + 1 >= srclen) @@ -877,9 +874,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) s[uoffset + 3]; #ifdef UV_IS_QUAD else if (size == 64) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); retnum = ((UV) s[uoffset ] << 56) + ((UV) s[uoffset + 1] << 48) + @@ -970,9 +966,8 @@ Perl_do_vecset(pTHX_ SV *sv) } #ifdef UV_IS_QUAD else if (size == 64) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); s[offset ] = (U8)((lval >> 56) & 0xff); s[offset+1] = (U8)((lval >> 48) & 0xff); s[offset+2] = (U8)((lval >> 40) & 0xff); @@ -998,18 +993,18 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) if (SvTYPE(sv) == SVt_PVAV) { register I32 i; - AV* const av = (AV*)sv; + AV *const av = MUTABLE_AV(sv); const I32 max = AvFILL(av); for (i = 0; i <= max; i++) { - sv = (SV*)av_fetch(av, i, FALSE); + sv = MUTABLE_SV(av_fetch(av, i, FALSE)); if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef)) do_chop(astr, sv); } return; } else if (SvTYPE(sv) == SVt_PVHV) { - HV* const hv = (HV*)sv; + HV* const hv = MUTABLE_HV(sv); HE* entry; (void)hv_iterinit(hv); while ((entry = hv_iternext(hv))) @@ -1022,7 +1017,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) sv_force_normal_flags(sv, 0); } if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + Perl_croak(aTHX_ "%s", PL_no_modify); } if (PL_encoding && !SvUTF8(sv)) { @@ -1050,7 +1045,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) } } else - sv_setpvn(astr, "", 0); + sv_setpvs(astr, ""); } else if (s && len) { s += --len; @@ -1061,7 +1056,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) SvNIOK_off(sv); } else - sv_setpvn(astr, "", 0); + sv_setpvs(astr, ""); SvSETMAGIC(sv); } @@ -1084,18 +1079,18 @@ Perl_do_chomp(pTHX_ register SV *sv) count = 0; if (SvTYPE(sv) == SVt_PVAV) { register I32 i; - AV* const av = (AV*)sv; + AV *const av = MUTABLE_AV(sv); const I32 max = AvFILL(av); for (i = 0; i <= max; i++) { - sv = (SV*)av_fetch(av, i, FALSE); + sv = MUTABLE_SV(av_fetch(av, i, FALSE)); if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef)) count += do_chomp(sv); } return count; } else if (SvTYPE(sv) == SVt_PVHV) { - HV* const hv = (HV*)sv; + HV* const hv = MUTABLE_HV(sv); HE* entry; (void)hv_iterinit(hv); while ((entry = hv_iternext(hv))) @@ -1108,7 +1103,7 @@ Perl_do_chomp(pTHX_ register SV *sv) sv_force_normal_flags(sv, 0); } if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + Perl_croak(aTHX_ "%s", PL_no_modify); } if (PL_encoding) { @@ -1196,8 +1191,7 @@ Perl_do_chomp(pTHX_ register SV *sv) } nope: - if (svrecode) - SvREFCNT_dec(svrecode); + SvREFCNT_dec(svrecode); Safefree(temp_buffer); return count; @@ -1228,8 +1222,14 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) PERL_ARGS_ASSERT_DO_VOP; if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) - sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */ - lsave = lc = SvPV_nomg_const(left, leftlen); + sv_setpvs(sv, ""); /* avoid undef warning on |= and ^= */ + if (sv == left) { + lsave = lc = SvPV_force_nomg(left, leftlen); + } + else { + lsave = lc = SvPV_nomg_const(left, leftlen); + SvPV_force_nomg_nolen(sv); + } rsave = rc = SvPV_nomg_const(right, rightlen); /* This need to come after SvPV to ensure that string overloading has @@ -1431,7 +1431,7 @@ Perl_do_kv(pTHX) { dVAR; dSP; - HV * const hv = (HV*)POPs; + HV * const hv = MUTABLE_HV(POPs); HV *keys; register HE *entry; const I32 gimme = GIMME_V; @@ -1465,16 +1465,15 @@ Perl_do_kv(pTHX) sv_magic(TARG, NULL, PERL_MAGIC_nkeys, NULL, 0); } LvTYPE(TARG) = 'k'; - if (LvTARG(TARG) != (SV*)keys) { - if (LvTARG(TARG)) - SvREFCNT_dec(LvTARG(TARG)); + if (LvTARG(TARG) != (const SV *)keys) { + SvREFCNT_dec(LvTARG(TARG)); LvTARG(TARG) = SvREFCNT_inc_simple(keys); } PUSHs(TARG); RETURN; } - if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied) ) + if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) { i = HvKEYS(keys); }