From ecad31f01819999d0e5aa744beb37e69192d8b71 Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Wed, 5 Oct 2011 12:48:07 -0700 Subject: [PATCH] Make gv.c and pp_ctl.c warnings utf8-clean --- gv.c | 56 ++++++++++++++++++++++++++++++++------------------------ pp_ctl.c | 42 ++++++++++++++++++++++++------------------ 2 files changed, 56 insertions(+), 42 deletions(-) diff --git a/gv.c b/gv.c index 52846fa..84ead52 100644 --- a/gv.c +++ b/gv.c @@ -715,8 +715,10 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, cstash = gv_stashsv(linear_sv, 0); if (!cstash) { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA", - SVfARG(linear_sv), hvname); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Can't locate package %"SVf" for @%"SVf"::ISA", + SVfARG(linear_sv), + SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash))))); continue; } @@ -1052,20 +1054,21 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash))))); } else { - STRLEN packlen; - const char *packname; + SV* packnamesv; if (nsplit) { - packlen = nsplit - origname; - packname = origname; + packnamesv = newSVpvn_flags(origname, nsplit - origname, + SVs_TEMP | is_utf8); } else { - packname = SvPV_const(error_report, packlen); + packnamesv = sv_2mortal(newSVsv(error_report)); } Perl_croak(aTHX_ - "Can't locate object method \"%s\" via package \"%.*s\"" - " (perhaps you forgot to load \"%.*s\"?)", - name, (int)packlen, packname, (int)packlen, packname); + "Can't locate object method \"%"SVf"\" via package \"%"SVf"\"" + " (perhaps you forgot to load \"%"SVf"\"?)", + SVfARG(newSVpvn_flags(name, nend - name, + SVs_TEMP | is_utf8)), + SVfARG(packnamesv), SVfARG(packnamesv)); } } } @@ -1155,8 +1158,9 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) && (GvCVGEN(gv) || GvSTASH(gv) != stash) ) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", - SvPV_nolen(packname), (int)len, name); + "Use of inherited AUTOLOAD for non-method %"SVf"::%"SVf"() is deprecated", + SVfARG(packname), + SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8))); if (CvISXSUB(cv)) { /* rather than lookup/init $AUTOLOAD here @@ -1403,7 +1407,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, goto no_stash; } - if (full_len > 2 && *name == '*' && isALPHA(name[1])) { + if (full_len > 2 && *name == '*' && isIDFIRST_lazy_if(name + 1, is_utf8)) { /* accidental stringify on a GV? */ name++; } @@ -1542,17 +1546,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) || (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) ) { + SV* namesv = newSVpvn_flags(name, len, SVs_TEMP | is_utf8); /* diag_listed_as: Variable "%s" is not imported%s */ Perl_ck_warner_d( aTHX_ packWARN(WARN_MISC), - "Variable \"%c%s\" is not imported", + "Variable \"%c%"SVf"\" is not imported", sv_type == SVt_PVAV ? '@' : sv_type == SVt_PVHV ? '%' : '$', - name); + SVfARG(namesv)); if (GvCVu(*gvp)) Perl_ck_warner_d( aTHX_ packWARN(WARN_MISC), - "\t(Did you mean &%s instead?)\n", name + "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv) ); stash = NULL; } @@ -1570,11 +1575,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (!stash) { if (add) { SV * const err = Perl_mess(aTHX_ - "Global symbol \"%s%s\" requires explicit package name", + "Global symbol \"%s%"SVf"\" requires explicit package name", (sv_type == SVt_PV ? "$" : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" - : ""), name); + : ""), SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8))); GV *gv; if (USE_UTF8_IN_NAMES) SvUTF8_on(err); @@ -1637,11 +1642,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, faking_it = SvOK(gv); if (add & GV_ADDWARN) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %"SVf" unexpectedly", + SVfARG(newSVpvn_flags(nambeg, name_cursor-nambeg, SVs_TEMP | is_utf8 ))); gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8); - if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) - : (PL_dowarn & G_WARN_ON ) ) ) + if ( isIDFIRST_lazy_if(name, is_utf8) + && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) : (PL_dowarn & G_WARN_ON ) ) ) GvMULTI_on(gv) ; /* set up magic where warranted */ @@ -2023,7 +2029,8 @@ Perl_gv_check(pTHX_ const HV *stash) if (hv != PL_defstash && hv != stash) gv_check(hv); /* nested package */ } - else if (isALPHA(*HeKEY(entry))) { + else if ( *HeKEY(entry) != '_' + && isIDFIRST_lazy_if(HeKEY(entry), HeUTF8(entry)) ) { const char *file; gv = MUTABLE_GV(HeVAL(entry)); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) @@ -2037,8 +2044,9 @@ Perl_gv_check(pTHX_ const HV *stash) = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0); #endif Perl_warner(aTHX_ packWARN(WARN_ONCE), - "Name \"%s::%s\" used only once: possible typo", - HvNAME_get(stash), GvNAME(gv)); + "Name \"%"SVf"::%"SVf"\" used only once: possible typo", + SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))), + SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv))))); } } } diff --git a/pp_ctl.c b/pp_ctl.c index 2d8c4f2..d35462c 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1657,8 +1657,8 @@ Perl_qerror(pTHX_ SV *err) if (PL_in_eval) { if (PL_in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s", - SvPV_nolen_const(err)); + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf, + SVfARG(err)); } else sv_catsv(ERRSV, err); @@ -1763,20 +1763,21 @@ Perl_die_unwind(pTHX_ SV *msv) PL_curcop = oldcop; if (optype == OP_REQUIRE) { - const char* const msg = SvPVx_nolen_const(exceptsv); (void)hv_store(GvHVn(PL_incgv), - SvPVX_const(namesv), SvCUR(namesv), + SvPVX_const(namesv), + SvUTF8(namesv) ? -SvCUR(namesv) : SvCUR(namesv), &PL_sv_undef, 0); /* note that unlike pp_entereval, pp_require isn't * supposed to trap errors. So now that we've popped the * EVAL that pp_require pushed, and processed the error * message, rethrow the error */ - Perl_croak(aTHX_ "%sCompilation failed in require", - *msg ? msg : "Unknown error\n"); + Perl_croak(aTHX_ "%"SVf"Compilation failed in require", + SVfARG(exceptsv ? exceptsv : newSVpvs_flags("Unknown error\n", + SVs_TEMP))); } if (in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s", - SvPV_nolen_const(exceptsv)); + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf, + SVfARG(exceptsv)); } else { sv_setsv(ERRSV, exceptsv); @@ -2478,7 +2479,8 @@ PP(pp_return) { /* Unassume the success we assumed earlier. */ (void)hv_delete(GvHVn(PL_incgv), - SvPVX_const(namesv), SvCUR(namesv), + SvPVX_const(namesv), + SvUTF8(namesv) ? -SvCUR(namesv) : SvCUR(namesv), G_DISCARD); DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv)); } @@ -3530,7 +3532,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) PERL_CONTEXT *cx; I32 optype; /* Used by POPEVAL. */ SV *namesv; - const char *msg; cx = NULL; namesv = NULL; @@ -3555,7 +3556,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) if (yystatus != 3) LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */ - msg = SvPVx_nolen_const(ERRSV); if (in_require) { if (!cx) { /* If cx is still NULL, it means that we didn't go in the @@ -3565,21 +3565,26 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) namesv = cx->blk_eval.old_namesv; } (void)hv_store(GvHVn(PL_incgv), - SvPVX_const(namesv), SvCUR(namesv), + SvPVX_const(namesv), + SvUTF8(namesv) ? -SvCUR(namesv) : SvCUR(namesv), &PL_sv_undef, 0); - Perl_croak(aTHX_ "%sCompilation failed in require", - *msg ? msg : "Unknown error\n"); + Perl_croak(aTHX_ "%"SVf"Compilation failed in require", + SVfARG(ERRSV + ? ERRSV + : newSVpvs_flags("Unknown error\n", SVs_TEMP))); } else if (startop) { if (yystatus != 3) { POPBLOCK(cx,PL_curpm); POPEVAL(cx); } - Perl_croak(aTHX_ "%sCompilation failed in regexp", - (*msg ? msg : "Unknown error\n")); + Perl_croak(aTHX_ "%"SVf"Compilation failed in regexp", + SVfARG(ERRSV + ? ERRSV + : newSVpvs_flags("Unknown error\n", SVs_TEMP))); } else { - if (!*msg) { + if (!*(SvPVx_nolen_const(ERRSV))) { sv_setpvs(ERRSV, "Compilation error"); } } @@ -4270,7 +4275,8 @@ PP(pp_leaveeval) { /* Unassume the success we assumed earlier. */ (void)hv_delete(GvHVn(PL_incgv), - SvPVX_const(namesv), SvCUR(namesv), + SvPVX_const(namesv), + SvUTF8(namesv) ? -SvCUR(namesv) : SvCUR(namesv), G_DISCARD); retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv)); -- 2.7.4