X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=904ee9f8781a62c985157273eb408c8454262bea;hb=cc50ac46d6f5968c34044ce7c501b06af15fc51a;hp=7be8607b7a5de20622558832506919847691dd6f;hpb=427181846486e3aa5034a647dc1922377185f4c0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 7be8607..904ee9f 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -164,8 +164,21 @@ PP(pp_concat) s = SvPV_force(TARG, len); } s = SvPV(right,len); - if (SvOK(TARG)) + if (SvOK(TARG)) { +#if defined(PERL_Y2KWARN) + if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) { + STRLEN n; + char *s = SvPV(TARG,n); + if (n >= 2 && s[n-2] == '1' && s[n-1] == '9' + && (n == 2 || !isDIGIT(s[n-3]))) + { + Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s", + "about to append an integer to '19'"); + } + } +#endif sv_catpvn(TARG,s,len); + } else sv_setpvn(TARG,s,len); /* suppress warning */ SETTARG; @@ -221,7 +234,7 @@ PP(pp_preinc) { djSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) - Perl_croak(aTHX_ PL_no_modify); + DIE(aTHX_ PL_no_modify); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) { @@ -1632,7 +1645,7 @@ PP(pp_subst) if (SvREADONLY(TARG) || (SvTYPE(TARG) > SVt_PVLV && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))) - Perl_croak(aTHX_ PL_no_modify); + DIE(aTHX_ PL_no_modify); PUTBACK; s = SvPV(TARG, len); @@ -2001,36 +2014,49 @@ PP(pp_leavesublv) /* Here we go for robustness, not for speed, so we change all * the refcounts so the caller gets a live guy. Cannot set * TEMP, so sv_2mortal is out of question. */ - if (!CvLVALUE(cxsub.cv)) - Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call"); + if (!CvLVALUE(cxsub.cv)) { + POPSUB2(); + PL_curpm = newpm; + DIE(aTHX_ "Can't modify non-lvalue subroutine call"); + } if (gimme == G_SCALAR) { MARK = newsp + 1; EXTEND_MORTAL(1); if (MARK == SP) { - if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) - Perl_croak(aTHX_ "Can't return a %s from lvalue subroutine", + if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { + POPSUB2(); + PL_curpm = newpm; + DIE(aTHX_ "Can't return a %s from lvalue subroutine", SvREADONLY(TOPs) ? "readonly value" : "temporary"); + } else { /* Can be a localized value * subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; SvREFCNT_inc(*mark); } } - else /* Should not happen? */ - Perl_croak(aTHX_ "%s returned from lvalue subroutine in scalar context", + else { /* Should not happen? */ + POPSUB2(); + PL_curpm = newpm; + DIE(aTHX_ "%s returned from lvalue subroutine in scalar context", (MARK > SP ? "Empty array" : "Array")); + } SP = MARK; } else if (gimme == G_ARRAY) { EXTEND_MORTAL(SP - newsp); for (mark = newsp + 1; mark <= SP; mark++) { - if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) - /* Might be flattened array after $#array = */ - Perl_croak(aTHX_ "Can't return %s from lvalue subroutine", + if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { + /* Might be flattened array after $#array = */ + PUTBACK; + POPSUB2(); + PL_curpm = newpm; + DIE(aTHX_ "Can't return %s from lvalue subroutine", (*mark != &PL_sv_undef) ? (SvREADONLY(TOPs) ? "a readonly value" : "a temporary") : "an uninitialized value"); + } else { mortalize: /* Can be a localized value subject to deletion. */ @@ -2112,7 +2138,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) SvUPGRADE(dbsv, SVt_PVIV); SvIOK_on(dbsv); SAVEIV(SvIVX(dbsv)); - SvIVX(dbsv) = (IV)PTR_CAST cv; /* Do it the quickest way */ + SvIVX(dbsv) = PTR2IV(cv); /* Do it the quickest way */ } if (CvXSUB(cv)) @@ -2245,7 +2271,7 @@ try_autoload: || !(sv = AvARRAY(av)[0])) { MUTEX_UNLOCK(CvMUTEXP(cv)); - Perl_croak(aTHX_ "no argument for locked method call"); + DIE(aTHX_ "no argument for locked method call"); } } if (SvROK(sv)) @@ -2509,10 +2535,7 @@ try_autoload: "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; - if (AvREAL(av)) { - av_clear(av); - AvREAL_off(av); - } + assert(!AvREAL(av)); #ifndef USE_THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);