X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=98b9b44d15315bf5667d236013be0d9169a89dbc;hb=de11ba31bba9f0eef0f76239d1d93a010926d6cf;hp=a2c16549ea70eb6292a48abcebd9fcc439a866f3;hpb=a385c4e7bdc7cbc9f50e4f013b7a373e7450e199;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index a2c1654..98b9b44 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,6 +1,6 @@ /* pp_hot.c * - * Copyright (c) 1991-2001, Larry Wall + * Copyright (c) 1991-2002, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -72,14 +72,7 @@ PP(pp_pushmark) PP(pp_stringify) { dSP; dTARGET; - STRLEN len; - char *s; - s = SvPV(TOPs,len); - sv_setpvn(TARG,s,len); - if (SvUTF8(TOPs)) - SvUTF8_on(TARG); - else - SvUTF8_off(TARG); + sv_copypv(TARG,TOPs); SETTARG; RETURN; } @@ -177,7 +170,7 @@ PP(pp_concat) if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9' && (llen == 2 || !isDIGIT(lpv[llen - 3]))) { - Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s", + Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %s", "about to append an integer to '19'"); } } @@ -237,7 +230,8 @@ PP(pp_eq) dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && SvROK(TOPm1s)) { - SETs(boolSV(SvRV(TOPs) == SvRV(TOPm1s))); + SP--; + SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s))); RETURN; } #endif @@ -252,53 +246,40 @@ PP(pp_eq) bool auvok = SvUOK(TOPm1s); bool buvok = SvUOK(TOPs); - if (!auvok && !buvok) { /* ## IV == IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); - - SP--; - SETs(boolSV(aiv == biv)); - RETURN; - } - if (auvok && buvok) { /* ## UV == UV ## */ - UV auv = SvUVX(TOPm1s); - UV buv = SvUVX(TOPs); + if (auvok == buvok) { /* ## IV == IV or UV == UV ## */ + /* Casting IV to UV before comparison isn't going to matter + on 2s complement. On 1s complement or sign&magnitude + (if we have any of them) it could to make negative zero + differ from normal zero. As I understand it. (Need to + check - is negative zero implementation defined behaviour + anyway?). NWC */ + UV buv = SvUVX(POPs); + UV auv = SvUVX(TOPs); - SP--; SETs(boolSV(auv == buv)); RETURN; } { /* ## Mixed IV,UV ## */ + SV *ivp, *uvp; IV iv; - UV uv; - /* == is commutative so swap if needed (save code) */ + /* == is commutative so doesn't matter which is left or right */ if (auvok) { - /* swap. top of stack (b) is the iv */ - iv = SvIVX(TOPs); - SP--; - if (iv < 0) { - /* As (a) is a UV, it's >0, so it cannot be == */ - SETs(&PL_sv_no); - RETURN; - } - uv = SvUVX(TOPs); - } else { - iv = SvIVX(TOPm1s); - SP--; - if (iv < 0) { - /* As (b) is a UV, it's >0, so it cannot be == */ - SETs(&PL_sv_no); - RETURN; - } - uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */ - } + /* top of stack (b) is the iv */ + ivp = *SP; + uvp = *--SP; + } else { + uvp = *SP; + ivp = *--SP; + } + iv = SvIVX(ivp); + if (iv < 0) { + /* As uv is a UV, it's >0, so it cannot be == */ + SETs(&PL_sv_no); + RETURN; + } /* we know iv is >= 0 */ - if (uv > (UV) IV_MAX) { - SETs(&PL_sv_no); - RETURN; - } - SETs(boolSV((UV)iv == uv)); + SETs(boolSV((UV)iv == SvUVX(uvp))); RETURN; } } @@ -314,10 +295,10 @@ PP(pp_eq) PP(pp_preinc) { dSP; - if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + if (SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); - if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && - SvIVX(TOPs) != IV_MAX) + if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) + && SvIVX(TOPs) != IV_MAX) { ++SvIVX(TOPs); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); @@ -339,6 +320,42 @@ PP(pp_or) } } +PP(pp_dor) +{ + /* Most of this is lifted straight from pp_defined */ + dSP; + register SV* sv; + + sv = TOPs; + if (!sv || !SvANY(sv)) { + --SP; + RETURNOP(cLOGOP->op_other); + } + + switch (SvTYPE(sv)) { + case SVt_PVAV: + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVHV: + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVCV: + if (CvROOT(sv) || CvXSUB(sv)) + RETURN; + break; + default: + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvOK(sv)) + RETURN; + } + + --SP; + RETURNOP(cLOGOP->op_other); +} + PP(pp_add) { dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); @@ -440,7 +457,7 @@ PP(pp_add) buv = (UV)-biv; } /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, - else "IV" now, independant of how it came in. + else "IV" now, independent of how it came in. if a, b represents positive, A, B negative, a maps to -A etc a + b => (a + b) A + b => -(a - b) @@ -590,7 +607,7 @@ PP(pp_print) goto had_magic; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); - SETERRNO(EBADF,VMS_RMS_IFI); + SETERRNO(EBADF,RMS_IFI); goto just_say_no; } else if (!(fp = IoOFP(io))) { @@ -600,7 +617,7 @@ PP(pp_print) else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); } - SETERRNO(EBADF,IoIFP(io)?VMS_RMS_FAC:VMS_RMS_IFI); + SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); goto just_say_no; } else { @@ -753,7 +770,7 @@ PP(pp_rv2av) EXTEND(SP, maxarg); if (SvRMAGICAL(av)) { U32 i; - for (i=0; i < maxarg; i++) { + for (i=0; i < (U32)maxarg; i++) { SV **svp = av_fetch(av, i, FALSE); SP[i+1] = (svp) ? *svp : &PL_sv_undef; } @@ -781,7 +798,7 @@ PP(pp_rv2hv) tryAMAGICunDEREF(to_hv); hv = (HV*)SvRV(sv); - if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) + if (SvTYPE(hv) != SVt_PVHV) DIE(aTHX_ "Not a HASH reference"); if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -795,7 +812,7 @@ PP(pp_rv2hv) } } else { - if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) { + if (SvTYPE(sv) == SVt_PVHV) { hv = (HV*)sv; if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -877,8 +894,6 @@ PP(pp_rv2hv) } else { dTARGET; - if (SvTYPE(hv) == SVt_PVAV) - hv = avhv_keys((AV*)hv); if (HvFILL(hv)) Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); @@ -890,89 +905,36 @@ PP(pp_rv2hv) } } -STATIC int -S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem, - SV **lastrelem) -{ - OP *leftop; - I32 i; - - leftop = ((BINOP*)PL_op)->op_last; - assert(leftop); - assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST); - leftop = ((LISTOP*)leftop)->op_first; - assert(leftop); - /* Skip PUSHMARK and each element already assigned to. */ - for (i = lelem - firstlelem; i > 0; i--) { - leftop = leftop->op_sibling; - assert(leftop); - } - if (leftop->op_type != OP_RV2HV) - return 0; - - /* pseudohash */ - if (av_len(ary) > 0) - av_fill(ary, 0); /* clear all but the fields hash */ - if (lastrelem >= relem) { - while (relem < lastrelem) { /* gobble up all the rest */ - SV *tmpstr; - assert(relem[0]); - assert(relem[1]); - /* Avoid a memory leak when avhv_store_ent dies. */ - tmpstr = sv_newmortal(); - sv_setsv(tmpstr,relem[1]); /* value */ - relem[1] = tmpstr; - if (avhv_store_ent(ary,relem[0],tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - relem += 2; - TAINT_NOT; - } - } - if (relem == lastrelem) - return 1; - return 2; -} - STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) { if (*relem) { SV *tmpstr; - if (ckWARN(WARN_MISC)) { + HE *didstore; + + if (ckWARN(WARN_MISC)) { if (relem == firstrelem && SvROK(*relem) && (SvTYPE(SvRV(*relem)) == SVt_PVAV || SvTYPE(SvRV(*relem)) == SVt_PVHV)) { - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference found where even-sized list expected"); } else - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in hash assignment"); } - if (SvTYPE(hash) == SVt_PVAV) { - /* pseudohash */ - tmpstr = sv_newmortal(); - if (avhv_store_ent((AV*)hash,*relem,tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - } - else { - HE *didstore; - tmpstr = NEWSV(29,0); - didstore = hv_store_ent(hash,*relem,tmpstr,0); - if (SvMAGICAL(hash)) { - if (SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - if (!didstore) - sv_2mortal(tmpstr); - } - } - TAINT_NOT; + + tmpstr = NEWSV(29,0); + didstore = hv_store_ent(hash,*relem,tmpstr,0); + if (SvMAGICAL(hash)) { + if (SvSMAGICAL(tmpstr)) + mg_set(tmpstr); + if (!didstore) + sv_2mortal(tmpstr); + } + TAINT_NOT; } } @@ -1024,19 +986,6 @@ PP(pp_aassign) case SVt_PVAV: ary = (AV*)sv; magic = SvMAGICAL(ary) != 0; - if (PL_op->op_private & OPpASSIGN_HASH) { - switch (do_maybe_phash(ary, lelem, firstlelem, relem, - lastrelem)) - { - case 0: - goto normal_array; - case 1: - do_oddball((HV*)ary, relem, firstrelem); - } - relem = lastrelem + 1; - break; - } - normal_array: av_clear(ary); av_extend(ary, lastrelem - relem); i = 0; @@ -1193,6 +1142,8 @@ PP(pp_qr) register PMOP *pm = cPMOP; SV *rv = sv_newmortal(); SV *sv = newSVrv(rv, "Regexp"); + if (pm->op_pmdynflags & PMdf_TAINTED) + SvTAINTED_on(rv); sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0); RETURNX(PUSHs(rv)); } @@ -1201,6 +1152,7 @@ PP(pp_match) { dSP; dTARG; register PMOP *pm = cPMOP; + PMOP *dynpm = pm; register char *t; register char *s; char *strend; @@ -1234,6 +1186,7 @@ PP(pp_match) PL_reg_match_utf8 = DO_UTF8(TARG); + /* PMdf_USED is set after a ?? matches once */ if (pm->op_pmdynflags & PMdf_USED) { failure: if (gimme == G_ARRAY) @@ -1241,16 +1194,19 @@ PP(pp_match) RETPUSHNO; } + /* empty pattern special-cased to use last successful pattern if possible */ if (!rx->prelen && PL_curpm) { pm = PL_curpm; rx = PM_GETRE(pm); } - if (rx->minlen > len) goto failure; + + if (rx->minlen > (I32)len) + goto failure; truebase = t = s; /* XXXX What part of this is needed with true \G-support? */ - if ((global = pm->op_pmflags & PMf_GLOBAL)) { + if ((global = dynpm->op_pmflags & PMf_GLOBAL)) { rx->startp[0] = -1; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); @@ -1303,8 +1259,8 @@ play_it_again: if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags)) { PL_curpm = pm; - if (pm->op_pmflags & PMf_ONCE) - pm->op_pmdynflags |= PMdf_USED; + if (dynpm->op_pmflags & PMf_ONCE) + dynpm->op_pmdynflags |= PMdf_USED; goto gotcha; } else @@ -1331,6 +1287,9 @@ play_it_again: /*SUPPRESS 560*/ if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) { len = rx->endp[i] - rx->startp[i]; + if (rx->endp[i] < 0 || rx->startp[i] < 0 || + len < 0 || len > strend - s) + DIE(aTHX_ "panic: pp_match start/end pointers"); s = rx->startp[i] + truebase; sv_setpvn(*SP, s, len); if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len)) @@ -1338,7 +1297,7 @@ play_it_again: } } if (global) { - if (pm->op_pmflags & PMf_CONTINUE) { + if (dynpm->op_pmflags & PMf_CONTINUE) { MAGIC* mg = 0; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) mg = mg_find(TARG, PERL_MAGIC_regex_global); @@ -1391,8 +1350,8 @@ yup: /* Confirmed by INTUIT */ RX_MATCH_TAINTED_on(rx); TAINT_IF(RX_MATCH_TAINTED(rx)); PL_curpm = pm; - if (pm->op_pmflags & PMf_ONCE) - pm->op_pmdynflags |= PMdf_USED; + if (dynpm->op_pmflags & PMf_ONCE) + dynpm->op_pmdynflags |= PMdf_USED; if (RX_MATCH_COPIED(rx)) Safefree(rx->subbeg); RX_MATCH_COPIED_off(rx); @@ -1429,7 +1388,7 @@ yup: /* Confirmed by INTUIT */ nope: ret_no: - if (global && !(pm->op_pmflags & PMf_CONTINUE)) { + if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) { if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg) @@ -1463,8 +1422,11 @@ Perl_do_readline(pTHX) call_method("READLINE", gimme); LEAVE; SPAGAIN; - if (gimme == G_SCALAR) - SvSetMagicSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) { + SV* result = POPs; + SvSetSV_nosteal(TARG, result); + PUSHTARG; + } RETURN; } fp = Nullfp; @@ -1501,7 +1463,7 @@ Perl_do_readline(pTHX) if (ckWARN2(WARN_GLOB, WARN_CLOSED) && (!io || !(IoFLAGS(io) & IOf_START))) { if (type == OP_GLOB) - Perl_warner(aTHX_ WARN_GLOB, + Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)", Strerror(errno)); else @@ -1522,10 +1484,14 @@ Perl_do_readline(pTHX) tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen) Sv_Grow(sv, 80); /* try short-buffering it */ - if (type == OP_RCATLINE) + offset = 0; + if (type == OP_RCATLINE && SvOK(sv)) { + if (!SvPOK(sv)) { + STRLEN n_a; + (void)SvPV_force(sv, n_a); + } offset = SvCUR(sv); - else - offset = 0; + } } else { sv = sv_2mortal(NEWSV(57, 80)); @@ -1558,7 +1524,7 @@ Perl_do_readline(pTHX) } else if (type == OP_GLOB) { if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) { - Perl_warner(aTHX_ WARN_GLOB, + Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (child exited with status %d%s)", (int)(STATUS_CURRENT >> 8), (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); @@ -1648,20 +1614,36 @@ PP(pp_helem) U32 lval = PL_op->op_flags & OPf_MOD || LVRET; U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; +#ifdef PERL_COPY_ON_WRITE + U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0; +#else U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; +#endif I32 preeminent = 0; if (SvTYPE(hv) == SVt_PVHV) { - if (PL_op->op_private & OPpLVAL_INTRO) - preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0); + if (PL_op->op_private & OPpLVAL_INTRO) { + MAGIC *mg; + HV *stash; + /* does the element we're localizing already exist? */ + preeminent = + /* can we determine whether it exists? */ + ( !SvRMAGICAL(hv) + || mg_find((SV*)hv, PERL_MAGIC_env) + || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied)) + /* Try to preserve the existenceness of a tied hash + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise */ + && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg)))) + && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) + && gv_fetchmethod_autoload(stash, "DELETE", TRUE) + ) + ) ? hv_exists_ent(hv, keysv, 0) : 1; + + } he = hv_fetch_ent(hv, keysv, lval && !defer, hash); svp = he ? &HeVAL(he) : 0; } - else if (SvTYPE(hv) == SVt_PVAV) { - if (PL_op->op_private & OPpLVAL_INTRO) - DIE(aTHX_ "Can't localize pseudo-hash element"); - svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, hash); - } else { RETPUSHUNDEF; } @@ -1901,6 +1883,7 @@ PP(pp_subst) int force_on_match = 0; I32 oldsave = PL_savestack_ix; STRLEN slen; + bool doutf8 = FALSE; /* known replacement string? */ dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv; @@ -1911,8 +1894,8 @@ PP(pp_subst) EXTEND(SP,1); } - if (SvFAKE(TARG) && SvREADONLY(TARG)) - sv_force_normal(TARG); + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); if (SvREADONLY(TARG) || (SvTYPE(TARG) > SVt_PVLV && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))) @@ -1973,10 +1956,30 @@ PP(pp_subst) once = !(rpm->op_pmflags & PMf_GLOBAL); /* known replacement string? */ - c = dstr ? SvPV(dstr, clen) : Nullch; - + if (dstr) { + /* replacement needing upgrading? */ + if (DO_UTF8(TARG) && !doutf8) { + SV *nsv = sv_newmortal(); + SvSetSV(nsv, dstr); + if (PL_encoding) + sv_recode_to_utf8(nsv, PL_encoding); + else + sv_utf8_upgrade(nsv); + c = SvPV(nsv, clen); + doutf8 = TRUE; + } + else { + c = SvPV(dstr, clen); + doutf8 = DO_UTF8(dstr); + } + } + else { + c = Nullch; + doutf8 = FALSE; + } + /* can do inplace substitution? */ - if (c && clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR)) + if (c && (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR)) && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) { if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL, r_flags | REXEC_CHECKED)) @@ -2073,6 +2076,8 @@ PP(pp_subst) SPAGAIN; } SvTAINT(TARG); + if (doutf8) + SvUTF8_on(TARG); LEAVE_SCOPE(oldsave); RETURN; } @@ -2080,8 +2085,6 @@ PP(pp_subst) if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL, r_flags | REXEC_CHECKED)) { - bool isutf8; - if (force_on_match) { force_on_match = 0; s = SvPV_force(TARG, len); @@ -2120,14 +2123,21 @@ PP(pp_subst) break; } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags)); - sv_catpvn(dstr, s, strend - s); + if (doutf8 && !DO_UTF8(dstr)) { + SV* nsv = sv_2mortal(newSVpvn(s, strend - s)); + + sv_utf8_upgrade(nsv); + sv_catpvn(dstr, SvPVX(nsv), SvCUR(nsv)); + } + else + sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); Safefree(SvPVX(TARG)); SvPVX(TARG) = SvPVX(dstr); SvCUR_set(TARG, SvCUR(dstr)); SvLEN_set(TARG, SvLEN(dstr)); - isutf8 = DO_UTF8(dstr); + doutf8 |= DO_UTF8(dstr); SvPVX(dstr) = 0; sv_free(dstr); @@ -2136,7 +2146,7 @@ PP(pp_subst) PUSHs(sv_2mortal(newSViv((I32)iters))); (void)SvPOK_only(TARG); - if (isutf8) + if (doutf8) SvUTF8_on(TARG); TAINT_IF(rxtainted); SvSETMAGIC(TARG); @@ -2892,11 +2902,11 @@ void Perl_sub_crush_depth(pTHX_ CV *cv) { if (CvANON(cv)) - Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on anonymous subroutine"); + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { SV* tmpstr = sv_newmortal(); gv_efullname3(tmpstr, CvGV(cv), Nullch); - Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"", + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%s\"", SvPVX(tmpstr)); } } @@ -2913,7 +2923,7 @@ PP(pp_aelem) SV *sv; if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Use of reference \"%s\" as array index", SvPV_nolen(elemsv)); + Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%s\" as array index", SvPV_nolen(elemsv)); if (elem > 0) elem -= PL_curcop->cop_arybase; if (SvTYPE(av) != SVt_PVAV)