From: Andy Lester Date: Thu, 30 Mar 2006 23:42:28 +0000 (-0600) Subject: Random accumulated patches X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4c19fe8d8a6e04364af0548bf783e83ab5987d2;p=p5sagit%2Fp5-mst-13.2.git Random accumulated patches Message-ID: <20060331054228.GA18940@petdance.com> p4raw-id: //depot/perl@27641 --- diff --git a/cop.h b/cop.h index 359a427..81712fa 100644 --- a/cop.h +++ b/cop.h @@ -417,7 +417,7 @@ struct block_loop { SvREFCNT_dec(cx->blk_loop.iterlval); \ if (CxITERVAR(cx)) { \ if (SvPADMY(cx->blk_loop.itersave)) { \ - SV **s_v_p = CxITERVAR(cx); \ + SV ** const s_v_p = CxITERVAR(cx); \ sv_2mortal(*s_v_p); \ *s_v_p = cx->blk_loop.itersave; \ } \ diff --git a/doio.c b/doio.c index 7ed4e97..3d29b59 100644 --- a/doio.c +++ b/doio.c @@ -2255,7 +2255,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) SETERRNO(EFAULT,SS_ACCVIO); /* can't do as caller requested */ return -1; } - shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); + shm = (char *)shmat(id, NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); if (shm == (char *)-1) /* I hate System V IPC, I really do */ return -1; if (optype == OP_SHMREAD) { diff --git a/dump.c b/dump.c index 8d4f063..c86d3e5 100644 --- a/dump.c +++ b/dump.c @@ -365,7 +365,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) op_dump(pm->op_pmreplroot); } if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) { - SV *tmpsv = newSVpvs(""); + SV * const tmpsv = newSVpvs(""); if (pm->op_pmdynflags & PMdf_USED) sv_catpv(tmpsv, ",USED"); if (pm->op_pmdynflags & PMdf_TAINTED) @@ -771,7 +771,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #ifdef PERL_MAD if (PL_madskills && o->op_madprop) { - SV *tmpsv = newSVpvn("", 0); + SV * const tmpsv = newSVpvn("", 0); MADPROP* mp = o->op_madprop; Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n"); level++; @@ -821,7 +821,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #else if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */ if (cSVOPo->op_sv) { - SV *tmpsv = newSV(0); + SV * const tmpsv = newSV(0); ENTER; SAVEFREESV(tmpsv); #ifdef PERL_MAD diff --git a/embed.fnc b/embed.fnc index 3cc2d14..0fdbf20 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1408,7 +1408,7 @@ sR |char* |skipspace |NN char *s sR |char* |swallow_bom |NN U8 *s s |void |checkcomma |NN const char *s|NN const char *name \ |NN const char *what -s |bool |feature_is_enabled|NN char* name|STRLEN namelen +s |bool |feature_is_enabled|NN const char* name|STRLEN namelen s |void |force_ident |NN const char *s|int kind s |void |incline |NN char *s s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv diff --git a/gv.c b/gv.c index e2724ee..090d667 100644 --- a/gv.c +++ b/gv.c @@ -896,7 +896,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, *gvp == (GV*)&PL_sv_undef || SvTYPE(*gvp) != SVt_PVGV) { - stash = 0; + stash = NULL; } else if ((sv_type == SVt_PV && !GvIMPORTED_SV(*gvp)) || (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) || @@ -908,7 +908,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, name); if (GvCVu(*gvp)) Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name); - stash = 0; + stash = NULL; } } } @@ -1359,7 +1359,7 @@ Perl_gp_ref(pTHX_ GP *gp) { dVAR; if (!gp) - return (GP*)NULL; + return NULL; gp->gp_refcnt++; if (gp->gp_cv) { if (gp->gp_cvgen) { @@ -1624,7 +1624,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table - : (CV **) NULL)) + : NULL)) && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ @@ -1742,7 +1742,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table - : (CV **) NULL)) + : NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; diff --git a/gv.h b/gv.h index e0cfeaa..ab74552 100644 --- a/gv.h +++ b/gv.h @@ -28,8 +28,7 @@ struct gp { #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define GvGP(gv) \ (*({GV *const shplep = (GV *) (gv); \ - assert(SvTYPE(shplep) == SVt_PVGV || \ - SvTYPE(shplep) == SVt_PVLV); \ + assert(SvTYPE(shplep) == SVt_PVGV || SvTYPE(shplep) == SVt_PVLV); \ assert(isGV_with_GP(shplep)); \ &((shplep)->sv_u.svu_gp);})) # define GvFLAGS(gv) \ @@ -56,7 +55,7 @@ struct gp { # define GvNAME_HEK(gv) (GvXPVGV(gv)->xiv_u.xivu_namehek) #endif -#define GvNAME_get(gv) (GvNAME_HEK(gv) ? HEK_KEY(GvNAME_HEK(gv)) : 0) +#define GvNAME_get(gv) (GvNAME_HEK(gv) ? HEK_KEY(GvNAME_HEK(gv)) : NULL) #define GvNAMELEN_get(gv) (GvNAME_HEK(gv) ? HEK_LEN(GvNAME_HEK(gv)) : 0) #define GvNAME(gv) GvNAME_get(gv) diff --git a/hv.c b/hv.c index e92a365..fab0e6a 100644 --- a/hv.c +++ b/hv.c @@ -1073,7 +1073,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return NULL; } if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { - S_hv_notallowed(aTHX_ k_flags, key, klen, + hv_notallowed(k_flags, key, klen, "Attempt to delete readonly key '%"SVf"' from" " a restricted hash"); } @@ -1115,7 +1115,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return sv; } if (SvREADONLY(hv)) { - S_hv_notallowed(aTHX_ k_flags, key, klen, + hv_notallowed(k_flags, key, klen, "Attempt to delete disallowed key '%"SVf"' from" " a restricted hash"); } diff --git a/mg.c b/mg.c index 2a38dda..210d681 100644 --- a/mg.c +++ b/mg.c @@ -544,7 +544,8 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) { - PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(mg); Perl_croak(aTHX_ PL_no_modify); NORETURN_FUNCTION_END; } @@ -716,7 +717,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) } #elif defined(WIN32) { - DWORD dwErr = GetLastError(); + const DWORD dwErr = GetLastError(); sv_setnv(sv, (NV)dwErr); if (dwErr) { PerlProc_GetOSError(sv, dwErr); @@ -2037,7 +2038,7 @@ Perl_vivify_defelem(pTHX_ SV *sv) if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) LvTARG(sv) = NULL; /* array can't be extended */ else { - SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE); + SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE); if (!svp || (value = *svp) == &PL_sv_undef) Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv)); } diff --git a/op.c b/op.c index ef05f5b..5187f3b 100644 --- a/op.c +++ b/op.c @@ -816,16 +816,16 @@ Perl_scalarvoid(pTHX_ OP *o) if (ckWARN(WARN_VOID)) { useless = "a constant"; if (o->op_private & OPpCONST_ARYBASE) - useless = 0; + useless = NULL; /* don't warn on optimised away booleans, eg * use constant Foo, 5; Foo || print; */ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) - useless = 0; + useless = NULL; /* the constants 0 and 1 are permitted as they are conventionally used as dummies in constructs like 1 while some_condition_with_side_effects; */ else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) - useless = 0; + useless = NULL; else if (SvPOK(sv)) { /* perl4's way of mixing documentation and code (before the invention of POD) was based on a @@ -837,7 +837,7 @@ Perl_scalarvoid(pTHX_ OP *o) if (strnEQ(maybe_macro, "di", 2) || strnEQ(maybe_macro, "ds", 2) || strnEQ(maybe_macro, "ig", 2)) - useless = 0; + useless = NULL; } } } @@ -1746,7 +1746,6 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) return o; type = o->op_type; - if (PL_madskills && type == OP_NULL && o->op_flags & OPf_KIDS) { (void)my_kid(cUNOPo->op_first, attrs, imopsp); return o; @@ -2106,8 +2105,7 @@ Perl_jmaybe(pTHX_ OP *o) { if (o->op_type == OP_LIST) { OP * const o2 - = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, - SVt_PV))); + = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV))); o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o)); } return o; @@ -3662,8 +3660,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, term, scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, - gv)))))); + newGVOP(OP_GV, 0, gv)))))); } else { doop = newUNOP(OP_DOFILE, 0, scalar(term)); @@ -4409,7 +4406,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP PADOFFSET padoff = 0; I32 iterflags = 0; I32 iterpflags = 0; - OP *madsv = 0; + OP *madsv = NULL; if (sv) { if (sv->op_type == OP_RV2SV) { /* symbol table variable */ @@ -4468,7 +4465,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP * set the STACKED flag to indicate that these values are to be * treated as min/max values by 'pp_iterinit'. */ - UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; + const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; LOGOP* const range = (LOGOP*) flip->op_first; OP* const left = range->op_first; OP* const right = left->op_sibling; diff --git a/perl.c b/perl.c index 9fe9f1e..2b4d1b2 100644 --- a/perl.c +++ b/perl.c @@ -360,7 +360,7 @@ perl_construct(pTHXx) if ((long) PL_mmap_page_size < 0) { if (errno) { SV * const error = ERRSV; - (void) SvUPGRADE(error, SVt_PV); + SvUPGRADE(error, SVt_PV); Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error)); } else @@ -3079,7 +3079,7 @@ Perl_moreswitches(pTHX_ char *s) } #endif /* __CYGWIN__ */ { - const char *start = ++s; + const char * const start = ++s; while (*s && !isSPACE(*s)) ++s; diff --git a/perl.h b/perl.h index 4da34ce..27d01ed 100644 --- a/perl.h +++ b/perl.h @@ -5075,7 +5075,7 @@ typedef struct am_table_short AMTS; # define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b)) #endif #ifndef Atoul -# define Atoul(s) Strtoul(s, (char **)NULL, 10) +# define Atoul(s) Strtoul(s, NULL, 10) #endif diff --git a/pp.c b/pp.c index 467ef22..0a99184 100644 --- a/pp.c +++ b/pp.c @@ -3886,7 +3886,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); } diff --git a/pp_ctl.c b/pp_ctl.c index 5621db6..3844331 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2502,7 +2502,7 @@ PP(pp_goto) /* find label */ - PL_lastgotoprobe = 0; + PL_lastgotoprobe = NULL; *enterops = 0; for (ix = cxstack_ix; ix >= 0; ix--) { cx = &cxstack[ix]; diff --git a/pp_hot.c b/pp_hot.c index 91940ad..9edf122 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -208,7 +208,7 @@ PP(pp_concat) dPOPTOPssrl; bool lbyte; STRLEN rlen; - const char *rpv = 0; + const char *rpv = NULL; bool rbyte = FALSE; bool rcopied = FALSE; @@ -350,13 +350,12 @@ PP(pp_eq) ivp = *--SP; } iv = SvIVX(ivp); - if (iv < 0) { + 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 */ - SETs(boolSV((UV)iv == SvUVX(uvp))); + else + /* we know iv is >= 0 */ + SETs(boolSV((UV)iv == SvUVX(uvp))); RETURN; } } @@ -1716,16 +1715,17 @@ Perl_do_readline(pTHX) continue; } } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ - const U8 * const s = (const U8*)SvPVX_const(sv) + offset; - const STRLEN len = SvCUR(sv) - offset; - const U8 *f; - - if (ckWARN(WARN_UTF8) && - !is_utf8_string_loc(s, len, &f)) - /* Emulate :encoding(utf8) warning in the same case. */ - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "utf8 \"\\x%02X\" does not map to Unicode", - f < (U8*)SvEND(sv) ? *f : 0); + if (ckWARN(WARN_UTF8)) { + const U8 * const s = (const U8*)SvPVX_const(sv) + offset; + const STRLEN len = SvCUR(sv) - offset; + const U8 *f; + + if (!is_utf8_string_loc(s, len, &f)) + /* Emulate :encoding(utf8) warning in the same case. */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); + } } if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { @@ -1778,32 +1778,28 @@ PP(pp_helem) const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0; I32 preeminent = 0; - if (SvTYPE(hv) == SVt_PVHV) { - 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) : NULL; - } - else { + if (SvTYPE(hv) != SVt_PVHV) RETPUSHUNDEF; - } + + 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) : NULL; if (lval) { if (!svp || *svp == &PL_sv_undef) { SV* lv; @@ -3097,7 +3093,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!stash) packsv = sv; else { - SV* ref = newSViv(PTR2IV(stash)); + SV* const ref = newSViv(PTR2IV(stash)); hv_store(PL_stashcache, packname, packlen, ref, 0); } goto fetch; diff --git a/pp_sort.c b/pp_sort.c index 7585b75..6e03d0e 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -180,12 +180,11 @@ typedef SV * gptr; /* pointers in our lists */ static IV -dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp) +dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp) { I32 sense; register gptr *b, *p, *q, *t, *p2; - register gptr c, *last, *r; - gptr *savep; + register gptr *last, *r; IV runs = 0; b = list1; @@ -217,7 +216,8 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp) } } if (q > b) { /* run of greater than 2 at b */ - savep = p; + gptr *savep = p; + p = q += 2; /* pick up singleton, if possible */ if ((p == t) && @@ -225,17 +225,18 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp) ((cmp(aTHX_ *(p-1), *p) > 0) == sense)) savep = r = p = q = last; p2 = NEXT(p2) = p2 + (p - b); ++runs; - if (sense) while (b < --p) { - c = *b; - *b++ = *p; - *p = c; - } + if (sense) + while (b < --p) { + const gptr c = *b; + *b++ = *p; + *p = c; + } p = savep; } while (q < p) { /* simple pairs */ p2 = NEXT(p2) = p2 + 2; ++runs; if (sense) { - c = *q++; + const gptr c = *q++; *(q-1) = *q; *q++ = c; } else q += 2; @@ -358,7 +359,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags) gptr small[SMALLSORT]; gptr *which[3]; off_runs stack[60], *stackp; - SVCOMPARE_t savecmp = 0; + SVCOMPARE_t savecmp = NULL; if (nmemb <= 1) return; /* sorted trivially */ @@ -1409,7 +1410,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) /* restore prevailing comparison routine */ PL_sort_RealCmp = savecmp; } else if ((flags & SORTf_DESC) != 0) { - SVCOMPARE_t savecmp = PL_sort_RealCmp; /* Save current comparison routine, if any */ + const SVCOMPARE_t savecmp = PL_sort_RealCmp; /* Save current comparison routine, if any */ PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */ cmp = cmp_desc; S_qsortsvu(aTHX_ list1, nmemb, cmp); @@ -1451,10 +1452,10 @@ Sort an array, with various options. void Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { - void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) - = ((flags & SORTf_QSORT) != 0 ? S_qsortsv : S_mergesortsv); - - sortsvp(aTHX_ array, nmemb, cmp, flags); + if (flags & SORTf_QSORT) + S_qsortsv(aTHX_ array, nmemb, cmp, flags); + else + S_mergesortsv(aTHX_ array, nmemb, cmp, flags); } #define SvNSIOK(sv) ((SvFLAGS(sv) & SVf_NOK) || ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK)) diff --git a/proto.h b/proto.h index 6bd5955..3f3d526 100644 --- a/proto.h +++ b/proto.h @@ -3849,7 +3849,7 @@ STATIC void S_checkcomma(pTHX_ const char *s, const char *name, const char *what __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); -STATIC bool S_feature_is_enabled(pTHX_ char* name, STRLEN namelen) +STATIC bool S_feature_is_enabled(pTHX_ const char* name, STRLEN namelen) __attribute__nonnull__(pTHX_1); STATIC void S_force_ident(pTHX_ const char *s, int kind) diff --git a/regcomp.c b/regcomp.c index 46960fb..7f5507d 100644 --- a/regcomp.c +++ b/regcomp.c @@ -1617,7 +1617,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, char * const s0 = STRING(scan), *s, *t; char * const s1 = s0 + STR_LEN(scan) - 1; char * const s2 = s1 - 4; - const char * const t0 = "\xcc\x88\xcc\x81"; + const char t0[] = "\xcc\x88\xcc\x81"; const char * const t1 = t0 + 3; for (s = s0 + 2; @@ -1678,7 +1678,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, if (OP(next) == code || code == IFTHEN || code == SUSPEND) { I32 max1 = 0, min1 = I32_MAX, num = 0; struct regnode_charclass_class accum; - regnode *startbranch=scan; + regnode * const startbranch=scan; if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */ scan_commit(pRExC_state, data); /* Cannot merge strings after this. */ @@ -2071,7 +2071,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, else if (strchr((const char*)PL_varies,OP(scan))) { I32 mincount, maxcount, minnext, deltanext, fl = 0; I32 f = flags, pos_before = 0; - regnode *oscan = scan; + regnode * const oscan = scan; struct regnode_charclass_class this_class; struct regnode_charclass_class *oclass = NULL; I32 next_is_eval = 0; @@ -2205,7 +2205,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, && !deltanext && minnext == 1 ) { /* Try to optimize to CURLYN. */ regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; - regnode *nxt1 = nxt; + regnode * const nxt1 = nxt; #ifdef DEBUGGING regnode *nxt2; #endif @@ -2334,7 +2334,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, I32 b = pos_before >= data->last_start_min ? pos_before : data->last_start_min; STRLEN l; - const char *s = SvPV_const(data->last_found, l); + const char * const s = SvPV_const(data->last_found, l); I32 old = b - data->last_start_min; #endif @@ -2383,8 +2383,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, the group. */ scan_commit(pRExC_state,data); if (mincount && last_str) { - SV *sv = data->last_found; - MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; if (mg) @@ -3665,7 +3665,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) *flagp |= flags&SIMPLE; } - return(ret); + return ret; } /* @@ -5230,10 +5230,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (range) { if (prevvalue > (IV)value) /* b-a */ { - Simple_vFAIL4("Invalid [] range \"%*.*s\"", - RExC_parse - rangebegin, - RExC_parse - rangebegin, - rangebegin); + const int w = RExC_parse - rangebegin; + Simple_vFAIL4("Invalid [] range \"%*.*s\"", w, w, rangebegin); range = 0; /* not a valid range */ } } @@ -5246,7 +5244,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) /* a bad range like \w-, [:word:]- ? */ if (namedclass > OOB_NAMEDCLASS) { if (ckWARN(WARN_REGEXP)) { - int w = + const int w = RExC_parse >= rangebegin ? RExC_parse - rangebegin : 0; vWARN4(RExC_parse, diff --git a/sv.c b/sv.c index fa670b1..ded27c9 100644 --- a/sv.c +++ b/sv.c @@ -1089,7 +1089,7 @@ S_more_bodies (pTHX_ svtype sv_type) void ** const r3wt = &PL_body_roots[sv_type]; \ LOCK_SV_MUTEX; \ xpv = *((void **)(r3wt)) \ - ? *((void **)(r3wt)) : S_more_bodies(aTHX_ sv_type); \ + ? *((void **)(r3wt)) : more_bodies(sv_type); \ *(r3wt) = *(void**)(xpv); \ UNLOCK_SV_MUTEX; \ } STMT_END @@ -1319,7 +1319,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) int length = old_type_details->copy; if (new_type_details->offset > old_type_details->offset) { - int difference + const int difference = new_type_details->offset - old_type_details->offset; offset += difference; length -= difference; @@ -3445,7 +3445,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) case SVt_PVGV: if (dtype <= SVt_PVGV) { - S_glob_assign_glob(aTHX_ dstr, sstr, dtype); + glob_assign_glob(dstr, sstr, dtype); return; } /*FALLTHROUGH*/ @@ -3458,7 +3458,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) if ((int)SvTYPE(sstr) != stype) { stype = SvTYPE(sstr); if (stype == SVt_PVGV && dtype <= SVt_PVGV) { - S_glob_assign_glob(aTHX_ dstr, sstr, dtype); + glob_assign_glob(dstr, sstr, dtype); return; } } @@ -3486,13 +3486,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) GvMULTI_on(dstr); return; } - S_glob_assign_glob(aTHX_ dstr, sstr, dtype); + glob_assign_glob(dstr, sstr, dtype); return; } if (dtype >= SVt_PV) { if (dtype == SVt_PVGV) { - S_glob_assign_ref(aTHX_ dstr, sstr); + glob_assign_ref(dstr, sstr); return; } if (SvPVX_const(dstr)) { @@ -5339,6 +5339,8 @@ S_sv_pos_u2b_forwards(pTHX_ const U8 *const start, const U8 *const send, { const U8 *s = start; + PERL_UNUSED_CONTEXT; + while (s < send && uoffset--) s += UTF8SKIP(s); if (s > send) { @@ -5791,7 +5793,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) if (SvMAGICAL(sv) && !SvREADONLY(sv) && PL_utf8cache && (mg = mg_find(sv, PERL_MAGIC_utf8))) { if (mg->mg_ptr) { - STRLEN *cache = (STRLEN *) mg->mg_ptr; + STRLEN * const cache = (STRLEN *) mg->mg_ptr; if (cache[1] == byte) { /* An exact match. */ *offsetp = cache[0]; @@ -9375,6 +9377,7 @@ ptr_table_* functions. #if defined(USE_ITHREADS) +/* XXX Remove this so it doesn't have to go thru the macro and return for nothing */ #ifndef GpREFCNT_inc # define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL) #endif @@ -9687,7 +9690,7 @@ S_ptr_table_find(PTR_TBL_t *tbl, const void *sv) { if (tblent->oldval == sv) return tblent; } - return 0; + return NULL; } void * @@ -9695,7 +9698,7 @@ Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv) { PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv); PERL_UNUSED_CONTEXT; - return tblent ? tblent->newval : (void *) 0; + return tblent ? tblent->newval : NULL; } /* add a new entry to a pointer-mapping table */ @@ -11816,7 +11819,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match) /* attempt to find a match within the aggregate */ if (hash) { - keysv = S_find_hash_subscript(aTHX_ (HV*)sv, uninit_sv); + keysv = find_hash_subscript((HV*)sv, uninit_sv); if (keysv) subscript_type = FUV_SUBSCRIPT_HASH; } @@ -11937,13 +11940,13 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match) /* index is an expression; * attempt to find a match within the aggregate */ if (obase->op_type == OP_HELEM) { - SV * const keysv = S_find_hash_subscript(aTHX_ (HV*)sv, uninit_sv); + SV * const keysv = find_hash_subscript((HV*)sv, uninit_sv); if (keysv) return varname(gv, '%', o->op_targ, keysv, 0, FUV_SUBSCRIPT_HASH); } else { - const I32 index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv); + const I32 index = find_array_subscript((AV*)sv, uninit_sv); if (index >= 0) return varname(gv, '@', o->op_targ, NULL, index, FUV_SUBSCRIPT_ARRAY); diff --git a/sv.h b/sv.h index cf2f656..1a83cf3 100644 --- a/sv.h +++ b/sv.h @@ -978,11 +978,11 @@ in gv.h: */ #define SvAMAGIC(sv) (SvROK(sv) && (SvFLAGS(SvRV(sv)) & SVf_AMAGIC)) #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvAMAGIC_on(sv) ({ SV *kloink = sv; \ +# define SvAMAGIC_on(sv) ({ SV * const kloink = sv; \ assert(SvROK(kloink)); \ SvFLAGS(SvRV(kloink)) |= SVf_AMAGIC; \ }) -# define SvAMAGIC_off(sv) ({ SV *kloink = sv; \ +# define SvAMAGIC_off(sv) ({ SV * const kloink = sv; \ if(SvROK(kloink)) \ SvFLAGS(SvRV(kloink)) &= ~SVf_AMAGIC;\ }) diff --git a/toke.c b/toke.c index 4bf4a85..c7a9d91 100644 --- a/toke.c +++ b/toke.c @@ -429,7 +429,8 @@ S_no_op(pTHX_ const char *what, char *s) "\t(Missing semicolon on previous line?)\n"); else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) { const char *t; - for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) ; + for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) + /**/; if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Do you need to predeclare %.*s?)\n", @@ -447,7 +448,7 @@ S_no_op(pTHX_ const char *what, char *s) /* * S_missingterm * Complain about missing quote/regexp/heredoc terminator. - * If it's called with (char *)NULL then it cauterizes the line buffer. + * If it's called with NULL then it cauterizes the line buffer. * If we're in a delimited string and the delimiter is a control * character, it's reformatted into a two-char sequence like ^C. * This is fatal. @@ -493,13 +494,13 @@ S_missingterm(pTHX_ char *s) * Check whether the named feature is enabled. */ STATIC bool -S_feature_is_enabled(pTHX_ char *name, STRLEN namelen) +S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen) { dVAR; HV * const hinthv = GvHV(PL_hintgv); char he_name[32] = "feature_"; (void) strncpy(&he_name[8], name, 24); - + return (hinthv && hv_exists(hinthv, he_name, 8 + namelen)); } @@ -711,7 +712,8 @@ S_incline(pTHX_ char *s) CopLINE_inc(PL_curcop); if (*s++ != '#') return; - while (SPACE_OR_TAB(*s)) s++; + while (SPACE_OR_TAB(*s)) + s++; if (strnEQ(s, "line", 4)) s += 4; else @@ -720,9 +722,11 @@ S_incline(pTHX_ char *s) s++; else return; - while (SPACE_OR_TAB(*s)) s++; + while (SPACE_OR_TAB(*s)) + s++; if (!isDIGIT(*s)) return; + n = s; while (isDIGIT(*s)) s++; @@ -813,7 +817,7 @@ S_skipspace0(pTHX_ register char *s) STATIC char * S_skipspace1(pTHX_ register char *s) { - char *start = s; + const char *start = s; I32 startoff = start - SvPVX(PL_linestr); s = skipspace(s); @@ -821,7 +825,7 @@ S_skipspace1(pTHX_ register char *s) return s; start = SvPVX(PL_linestr) + startoff; if (!PL_thistoken && PL_realtokenstart >= 0) { - char *tstart = SvPVX(PL_linestr) + PL_realtokenstart; + const char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart; PL_thistoken = newSVpvn(tstart, start - tstart); } PL_realtokenstart = -1; @@ -847,7 +851,7 @@ S_skipspace2(pTHX_ register char *s, SV **svp) return s; start = SvPVX(PL_linestr) + startoff; if (!PL_thistoken && PL_realtokenstart >= 0) { - char *tstart = SvPVX(PL_linestr) + PL_realtokenstart; + char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart; PL_thistoken = newSVpvn(tstart, start - tstart); PL_realtokenstart = -1; } @@ -1064,14 +1068,15 @@ STATIC void S_check_uni(pTHX) { dVAR; - char *s; - char *t; + const char *s; + const char *t; if (PL_oldoldbufptr != PL_last_uni) return; while (isSPACE(*PL_last_uni)) PL_last_uni++; - for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) ; + for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) + /**/; if ((t = strchr(s, '(')) && t < PL_bufptr) return; @@ -1189,8 +1194,8 @@ S_curmad(pTHX_ char slot, SV *sv) addmad(newMADsv(slot, sv), where, 0); } #else -# define start_force(where) -# define curmad(slot, sv) +# define start_force(where) /*EMPTY*/ +# define curmad(slot, sv) /*EMPTY*/ #endif /* @@ -1774,7 +1779,7 @@ S_scan_const(pTHX_ char *start) UV literal_endpoint = 0; #endif - const char *leaveit = /* set of acceptably-backslashed characters */ + const char * const leaveit = /* set of acceptably-backslashed characters */ PL_lex_inpat ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxz0123456789[{]} \t\n\r\f\v#" : ""; @@ -3130,7 +3135,7 @@ Perl_yylex(pTHX) else Perl_croak(aTHX_ "panic: yylex"); if (PL_madskills) { - SV* tmpsv = newSVpvn("",0); + SV* const tmpsv = newSVpvn("",0); Perl_sv_catpvf(aTHX_ tmpsv, "\\%c", *s); curmad('_', tmpsv); } @@ -3649,7 +3654,8 @@ Perl_yylex(pTHX) do { if (*d == 'M' || *d == 'm' || *d == 'C') { const char * const m = d; - while (*d && !isSPACE(*d)) d++; + while (*d && !isSPACE(*d)) + d++; Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); } @@ -4505,7 +4511,7 @@ Perl_yylex(pTHX) const char tmp = *s++; if (tmp == '>') SHop(OP_RIGHT_SHIFT); - if (tmp == '=') + else if (tmp == '=') Rop(OP_GE); } s--; @@ -4775,7 +4781,7 @@ Perl_yylex(pTHX) no_op("String",s); } if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; TERM(sublex_start()); @@ -4792,7 +4798,7 @@ Perl_yylex(pTHX) no_op("String",s); } if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; /* FIXME. I think that this can be const if char *d is replaced by more localised variables. */ @@ -4810,7 +4816,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) no_op("Backticks",s); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -4837,6 +4843,7 @@ Perl_yylex(pTHX) else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE || PL_expect == XTERMORDORDOR)) { + /* XXX Use gv_fetchpvn rather than stomping on a const string */ const char c = *start; GV *gv; *start = '\0'; @@ -6040,7 +6047,7 @@ Perl_yylex(pTHX) case KEY_q: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; TERM(sublex_start()); @@ -6050,7 +6057,7 @@ Perl_yylex(pTHX) case KEY_qw: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); PL_expect = XOPERATOR; force_next(')'); if (SvCUR(PL_lex_stuff)) { @@ -6058,9 +6065,10 @@ Perl_yylex(pTHX) int warned = 0; d = SvPV_force(PL_lex_stuff, len); while (len) { - SV *sv; - for (; isSPACE(*d) && len; --len, ++d) ; + for (; isSPACE(*d) && len; --len, ++d) + /**/; if (len) { + SV *sv; const char *b = d; if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { @@ -6077,7 +6085,8 @@ Perl_yylex(pTHX) } } else { - for (; !isSPACE(*d) && len; --len, ++d) ; + for (; !isSPACE(*d) && len; --len, ++d) + /**/; } sv = newSVpvn(b, d-b); if (DO_UTF8(PL_lex_stuff)) @@ -6102,7 +6111,7 @@ Perl_yylex(pTHX) case KEY_qq: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_STRINGIFY; if (SvIVX(PL_lex_stuff) == '\'') SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */ @@ -6115,7 +6124,7 @@ Perl_yylex(pTHX) case KEY_qx: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -12446,22 +12455,20 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv) if (!isALPHA(*pos)) { U8 tmpbuf[UTF8_MAXBYTES+1]; - if (*s == 'v') s++; /* get past 'v' */ + if (*s == 'v') + s++; /* get past 'v' */ sv_setpvn(sv, "", 0); for (;;) { + /* this is atoi() that tolerates underscores */ U8 *tmpend; UV rev = 0; - { - /* this is atoi() that tolerates underscores */ - const char *end = pos; - UV mult = 1; - while (--end >= s) { - UV orev; - if (*end == '_') - continue; - orev = rev; + const char *end = pos; + UV mult = 1; + while (--end >= s) { + if (*end != '_') { + const UV orev = rev; rev += (*end - '0') * mult; mult *= 10; if (orev > rev && ckWARN_d(WARN_OVERFLOW)) diff --git a/utf8.c b/utf8.c index 2de924f..1e39edc 100644 --- a/utf8.c +++ b/utf8.c @@ -403,7 +403,7 @@ UV Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) { dVAR; - const U8 *s0 = s; + const U8 * const s0 = s; UV uv = *s, ouv = 0; STRLEN len = 1; const bool dowarn = ckWARN_d(WARN_UTF8); @@ -755,12 +755,12 @@ Returns zero on failure, setting C to -1. U8 * Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len) { - U8 *send; + U8 * const save = s; + U8 * const send = s + *len; U8 *d; - U8 *save = s; /* ensure valid UTF-8 and chars < 256 before updating string */ - for (send = s + *len; s < send; ) { + while (s < send) { U8 c = *s++; if (!UTF8_IS_INVARIANT(c) && @@ -941,9 +941,9 @@ U8* Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen) { U8* s = (U8*)p; - U8* send = s + bytelen; + U8* const send = s + bytelen; while (s < send) { - U8 tmp = s[0]; + const U8 tmp = s[0]; s[0] = s[1]; s[1] = tmp; s += 2; @@ -1228,14 +1228,14 @@ Perl_is_utf8_alnum(pTHX_ const U8 *p) /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true * descendant of isalnum(3), in other words, it doesn't * contain the '_'. --jhi */ - return S_is_utf8_common(aTHX_ p, &PL_utf8_alnum, "IsWord"); + return is_utf8_common(p, &PL_utf8_alnum, "IsWord"); } bool Perl_is_utf8_alnumc(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_alnumc, "IsAlnumC"); + return is_utf8_common(p, &PL_utf8_alnumc, "IsAlnumC"); } bool @@ -1245,7 +1245,7 @@ Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */ if (*p == '_') return TRUE; /* is_utf8_idstart would be more logical. */ - return S_is_utf8_common(aTHX_ p, &PL_utf8_idstart, "IdStart"); + return is_utf8_common(p, &PL_utf8_idstart, "IdStart"); } bool @@ -1254,91 +1254,91 @@ Perl_is_utf8_idcont(pTHX_ const U8 *p) dVAR; if (*p == '_') return TRUE; - return S_is_utf8_common(aTHX_ p, &PL_utf8_idcont, "IdContinue"); + return is_utf8_common(p, &PL_utf8_idcont, "IdContinue"); } bool Perl_is_utf8_alpha(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_alpha, "IsAlpha"); + return is_utf8_common(p, &PL_utf8_alpha, "IsAlpha"); } bool Perl_is_utf8_ascii(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_ascii, "IsAscii"); + return is_utf8_common(p, &PL_utf8_ascii, "IsAscii"); } bool Perl_is_utf8_space(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_space, "IsSpacePerl"); + return is_utf8_common(p, &PL_utf8_space, "IsSpacePerl"); } bool Perl_is_utf8_digit(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_digit, "IsDigit"); + return is_utf8_common(p, &PL_utf8_digit, "IsDigit"); } bool Perl_is_utf8_upper(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_upper, "IsUppercase"); + return is_utf8_common(p, &PL_utf8_upper, "IsUppercase"); } bool Perl_is_utf8_lower(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_lower, "IsLowercase"); + return is_utf8_common(p, &PL_utf8_lower, "IsLowercase"); } bool Perl_is_utf8_cntrl(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_cntrl, "IsCntrl"); + return is_utf8_common(p, &PL_utf8_cntrl, "IsCntrl"); } bool Perl_is_utf8_graph(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_graph, "IsGraph"); + return is_utf8_common(p, &PL_utf8_graph, "IsGraph"); } bool Perl_is_utf8_print(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_print, "IsPrint"); + return is_utf8_common(p, &PL_utf8_print, "IsPrint"); } bool Perl_is_utf8_punct(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_punct, "IsPunct"); + return is_utf8_common(p, &PL_utf8_punct, "IsPunct"); } bool Perl_is_utf8_xdigit(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_xdigit, "Isxdigit"); + return is_utf8_common(p, &PL_utf8_xdigit, "Isxdigit"); } bool Perl_is_utf8_mark(pTHX_ const U8 *p) { dVAR; - return S_is_utf8_common(aTHX_ p, &PL_utf8_mark, "IsM"); + return is_utf8_common(p, &PL_utf8_mark, "IsM"); } /* @@ -1411,7 +1411,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, STRLEN tlen = 0; while (t < tend) { - UV c = utf8_to_uvchr(t, &tlen); + const UV c = utf8_to_uvchr(t, &tlen); if (tlen > 0) { d = uvchr_to_utf8(d, UNI_TO_NATIVE(c)); t += tlen; @@ -1436,12 +1436,11 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, } if (!len && *swashp) { - UV uv2 = swash_fetch(*swashp, tmpbuf, TRUE); - + const UV uv2 = swash_fetch(*swashp, tmpbuf, TRUE); + if (uv2) { /* It was "normal" (a single character mapping). */ - UV uv3 = UNI_TO_NATIVE(uv2); - + const UV uv3 = UNI_TO_NATIVE(uv2); len = uvchr_to_utf8(ustrp, uv3) - ustrp; } } @@ -1744,7 +1743,6 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8) return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ; } Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width"); - return 0; } /* Note: @@ -2199,7 +2197,8 @@ The flags argument is as in pv_uni_display(). The pointer to the PV of the dsv is returned. -=cut */ +=cut +*/ char * Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) {