X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=476fd805d09902166fa516878a280f9e7efe2391;hb=4dc4bba60f13ed8dad154870e750085525979ec1;hp=8c485765241debb824e0daaf1c8bc58407cf22a5;hpb=005a8a35ce5b6191102f848d17a5c617740a685c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 8c48576..476fd80 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,7 +1,7 @@ /* pp_hot.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 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. @@ -150,7 +150,7 @@ PP(pp_sassign) SV *const value = SvRV(cv); SvUPGRADE((SV *)gv, SVt_RV); - SvROK_on(gv); + SvPCS_IMPORTED_on(gv); SvRV_set(gv, value); SvREFCNT_inc_simple_void(value); SETs(right); @@ -1523,7 +1523,7 @@ yup: /* Confirmed by INTUIT */ if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n", - (int) SvTYPE(TARG), truebase, t, + (int) SvTYPE(TARG), (void*)truebase, (void*)t, (int)(t-truebase)); } rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG); @@ -1838,7 +1838,7 @@ PP(pp_helem) SV* lv; SV* key2; if (!defer) { - DIE(aTHX_ PL_no_helem_sv, keysv); + DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); } lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); @@ -2120,7 +2120,8 @@ PP(pp_subst) !is_cow && #endif (SvREADONLY(TARG) - || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV) + || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) + || SvTYPE(TARG) > SVt_PVLV) && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) DIE(aTHX_ PL_no_modify); PUTBACK; @@ -2682,43 +2683,6 @@ PP(pp_leavesublv) return cx->blk_sub.retop; } - -void -Perl_get_db_sub(pTHX_ SV **svp, CV *cv) -{ - dVAR; - SV * const dbsv = GvSVn(PL_DBsub); - /* We do not care about using sv to call CV; - * it's for informational purposes only. - */ - - save_item(dbsv); - if (!PERLDB_SUB_NN) { - GV * const gv = CvGV(cv); - - if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) - || strEQ(GvNAME(gv), "END") - || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ - !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) { - /* Use GV from the stack as a fallback. */ - /* GV is potentially non-unique, or contain different CV. */ - SV * const tmp = newRV((SV*)cv); - sv_setsv(dbsv, tmp); - SvREFCNT_dec(tmp); - } - else { - gv_efullname3(dbsv, gv, NULL); - } - } - else { - const int type = SvTYPE(dbsv); - if (type < SVt_PVIV && type != SVt_IV) - sv_upgrade(dbsv, SVt_PVIV); - (void)SvIOK_on(dbsv); - SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */ - } -} - PP(pp_entersub) { dVAR; dSP; dPOPss; @@ -2813,7 +2777,7 @@ try_autoload: else { sub_name = sv_newmortal(); gv_efullname3(sub_name, gv, NULL); - DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name); + DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name)); } } if (!cv) @@ -2901,7 +2865,7 @@ try_autoload: sub_crush_depth(cv); #if 0 DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p entersub returning %p\n", thr, CvSTART(cv))); + "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv))); #endif RETURNOP(CvSTART(cv)); } @@ -2957,7 +2921,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) SV* const tmpstr = sv_newmortal(); gv_efullname3(tmpstr, CvGV(cv), NULL); Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"", - (void*)tmpstr); + SVfARG(tmpstr)); } } @@ -2975,7 +2939,7 @@ PP(pp_aelem) if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", - (void*)elemsv); + SVfARG(elemsv)); if (elem > 0) elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV)