X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=6136d21e6030d71786825e849882b23764460a83;hb=ce5e94717f361c3fd6b9b0fb704412d30f3ccf66;hp=467ef225d2d7f16fed5684bd5be0d2f8d7715d5d;hpb=919acde01827c5ad450bac06c554f5a69eb06cef;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 467ef22..6136d21 100644 --- a/pp.c +++ b/pp.c @@ -334,7 +334,7 @@ PP(pp_pos) I32 i = mg->mg_len; if (DO_UTF8(sv)) sv_pos_b2u(sv, &i); - PUSHi(i + PL_curcop->cop_arybase); + PUSHi(i + CopARYBASE_get(PL_curcop)); RETURN; } } @@ -998,7 +998,47 @@ PP(pp_pow) #endif { dPOPTOPnnrl; + +#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG) + /* + We are building perl with long double support and are on an AIX OS + afflicted with a powl() function that wrongly returns NaNQ for any + negative base. This was reported to IBM as PMR #23047-379 on + 03/06/2006. The problem exists in at least the following versions + of AIX and the libm fileset, and no doubt others as well: + + AIX 4.3.3-ML10 bos.adt.libm 4.3.3.50 + AIX 5.1.0-ML04 bos.adt.libm 5.1.0.29 + AIX 5.2.0 bos.adt.libm 5.2.0.85 + + So, until IBM fixes powl(), we provide the following workaround to + handle the problem ourselves. Our logic is as follows: for + negative bases (left), we use fmod(right, 2) to check if the + exponent is an odd or even integer: + + - if odd, powl(left, right) == -powl(-left, right) + - if even, powl(left, right) == powl(-left, right) + + If the exponent is not an integer, the result is rightly NaNQ, so + we just return that (as NV_NAN). + */ + + if (left < 0.0) { + NV mod2 = Perl_fmod( right, 2.0 ); + if (mod2 == 1.0 || mod2 == -1.0) { /* odd integer */ + SETn( -Perl_pow( -left, right) ); + } else if (mod2 == 0.0) { /* even integer */ + SETn( Perl_pow( -left, right) ); + } else { /* fractional power */ + SETn( NV_NAN ); + } + } else { + SETn( Perl_pow( left, right) ); + } +#else SETn( Perl_pow( left, right) ); +#endif /* HAS_AIX_POWL_NEG_BASE_BUG */ + #ifdef PERL_PRESERVE_IVUV if (is_int) SvIV_please(TOPs); @@ -2389,16 +2429,16 @@ PP(pp_complement) if (SvUTF8(TARG)) { /* Calculate exact length, let's not estimate. */ STRLEN targlen = 0; - U8 *result; - U8 *send; STRLEN l; UV nchar = 0; UV nwide = 0; + U8 * const send = tmps + len; + U8 * const origtmps = tmps; + const UV utf8flags = UTF8_ALLOW_ANYUV; - send = tmps + len; while (tmps < send) { - const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); - tmps += UTF8SKIP(tmps); + const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); + tmps += l; targlen += UNISKIP(~c); nchar++; if (c > 0xff) @@ -2406,33 +2446,39 @@ PP(pp_complement) } /* Now rewind strings and write them. */ - tmps -= len; + tmps = origtmps; if (nwide) { - Newxz(result, targlen + 1, U8); + U8 *result; + U8 *p; + + Newx(result, targlen + 1, U8); + p = result; while (tmps < send) { - const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); - tmps += UTF8SKIP(tmps); - result = uvchr_to_utf8_flags(result, ~c, UNICODE_ALLOW_ANY); + const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); + tmps += l; + p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY); } - *result = '\0'; - result -= targlen; - sv_setpvn(TARG, (char*)result, targlen); + *p = '\0'; + sv_usepvn_flags(TARG, (char*)result, targlen, + SV_HAS_TRAILING_NUL); SvUTF8_on(TARG); } else { - Newxz(result, nchar + 1, U8); + U8 *result; + U8 *p; + + Newx(result, nchar + 1, U8); + p = result; while (tmps < send) { - const U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY); - tmps += UTF8SKIP(tmps); - *result++ = ~c; + const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); + tmps += l; + *p++ = ~c; } - *result = '\0'; - result -= nchar; - sv_setpvn(TARG, (char*)result, nchar); + *p = '\0'; + sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL); SvUTF8_off(TARG); } - Safefree(result); SETs(TARG); RETURN; } @@ -2923,7 +2969,7 @@ PP(pp_substr) I32 fail; const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; const char *tmps; - const I32 arybase = PL_curcop->cop_arybase; + const I32 arybase = CopARYBASE_get(PL_curcop); SV *repl_sv = NULL; const char *repl = NULL; STRLEN repl_len; @@ -3124,7 +3170,7 @@ PP(pp_index) I32 retval; const char *tmps; const char *tmps2; - const I32 arybase = PL_curcop->cop_arybase; + const I32 arybase = CopARYBASE_get(PL_curcop); bool big_utf8; bool little_utf8; const bool is_index = PL_op->op_type == OP_INDEX; @@ -3673,7 +3719,7 @@ PP(pp_aslice) register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); if (SvTYPE(av) == SVt_PVAV) { - const I32 arybase = PL_curcop->cop_arybase; + const I32 arybase = CopARYBASE_get(PL_curcop); if (lval && PL_op->op_private & OPpLVAL_INTRO) { register SV **svp; I32 max = -1; @@ -3886,7 +3932,7 @@ PP(pp_hslice) save_helem(hv, keysv, svp); else { STRLEN keylen; - const char *key = SvPV_const(keysv, keylen); + const char * const key = SvPV_const(keysv, keylen); SAVEDELETE(hv, savepvn(key,keylen), SvUTF8(keysv) ? -keylen : keylen); } @@ -3926,7 +3972,7 @@ PP(pp_lslice) SV ** const lastlelem = PL_stack_base + POPMARK; SV ** const firstlelem = PL_stack_base + POPMARK + 1; register SV ** const firstrelem = lastlelem + 1; - const I32 arybase = PL_curcop->cop_arybase; + const I32 arybase = CopARYBASE_get(PL_curcop); I32 is_something_there = PL_op->op_flags & OPf_MOD; register const I32 max = lastrelem - lastlelem; @@ -4013,7 +4059,6 @@ PP(pp_splice) I32 newlen; I32 after; I32 diff; - SV **tmparyval = NULL; const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); if (mg) { @@ -4034,7 +4079,7 @@ PP(pp_splice) if (offset < 0) offset += AvFILLp(ary) + 1; else - offset -= PL_curcop->cop_arybase; + offset -= CopARYBASE_get(PL_curcop); if (offset < 0) DIE(aTHX_ PL_no_aelem, i); if (++MARK < SP) { @@ -4079,6 +4124,7 @@ PP(pp_splice) } if (diff < 0) { /* shrinking the area */ + SV **tmparyval; if (newlen) { Newx(tmparyval, newlen, SV*); /* so remember insertion */ Copy(MARK, tmparyval, newlen, SV*); @@ -4139,15 +4185,14 @@ PP(pp_splice) } } else { /* no, expanding (or same) */ + SV** tmparyval = NULL; if (length) { Newx(tmparyval, length, SV*); /* so remember deletion */ Copy(AvARRAY(ary)+offset, tmparyval, length, SV*); } if (diff > 0) { /* expanding */ - /* push up or down? */ - if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) { if (offset) { src = AvARRAY(ary); @@ -4188,7 +4233,6 @@ PP(pp_splice) dst++; } } - Safefree(tmparyval); } MARK += length - 1; } @@ -4199,10 +4243,10 @@ PP(pp_splice) while (length-- > 0) SvREFCNT_dec(tmparyval[length]); } - Safefree(tmparyval); } else *MARK = &PL_sv_undef; + Safefree(tmparyval); } SP = MARK; RETURN; @@ -4301,7 +4345,7 @@ PP(pp_reverse) register I32 tmp; dTARGET; STRLEN len; - I32 padoff_du; + PADOFFSET padoff_du; SvUTF8_off(TARG); /* decontaminate */ if (SP - MARK > 1)