From 9d4ba2ae61ff15b15f3e889810ff89dfb2ed1738 Mon Sep 17 00:00:00 2001 From: Andy Lester Date: Mon, 27 Jun 2005 08:06:59 -0500 Subject: [PATCH] We're going round in circles with pp_sys.c Message-ID: <20050627180659.GB29744@petdance.com> (edited) p4raw-id: //depot/perl@24997 --- embed.fnc | 16 ++++++++-------- gv.c | 26 +++++++++++++------------- handy.h | 2 +- hv.c | 24 +++++++++++------------- perl.c | 28 ++++++++++++++++++++-------- pp_ctl.c | 29 +++++++++++++++++------------ pp_hot.c | 1 + proto.h | 14 ++++++-------- regexec.c | 10 ++++++---- sv.c | 8 ++++---- toke.c | 50 +++++++++++++++++++++++++------------------------- 11 files changed, 112 insertions(+), 96 deletions(-) diff --git a/embed.fnc b/embed.fnc index d5f44f3..8962aa9 100644 --- a/embed.fnc +++ b/embed.fnc @@ -152,7 +152,7 @@ Apd |SV* |cv_const_sv |CV* cv p |SV* |op_const_sv |const OP* o|CV* cv Apd |void |cv_undef |CV* cv Ap |void |cx_dump |PERL_CONTEXT* cs -Ap |SV* |filter_add |filter_t funcp|SV* datasv +Ap |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv Ap |void |filter_del |filter_t funcp Ap |I32 |filter_read |int idx|SV* buffer|int maxlen ApPR |char** |get_op_descs @@ -310,7 +310,7 @@ pd |U32 |intro_my ApPR |char* |instr |NN const char* big|NN const char* little pR |bool |io_close |NN IO* io|bool not_implicit pR |OP* |invert |OP* cmd -dpR |bool |is_gv_magical |const char *name|STRLEN len|U32 flags +dpR |bool |is_gv_magical |NN const char *name|STRLEN len|U32 flags ApR |I32 |is_lvalue_sub ApPR |U32 |to_uni_upper_lc|U32 c ApPR |U32 |to_uni_title_lc|U32 c @@ -765,8 +765,8 @@ Apd |void |sv_insert |NN SV* bigsv|STRLEN offset|STRLEN len \ |NN const char* little|STRLEN littlelen Apd |int |sv_isa |NN SV* sv|const char* name Apd |int |sv_isobject |NN SV* sv -Apd |STRLEN |sv_len |NN SV* sv -Apd |STRLEN |sv_len_utf8 |NN SV* sv +Apd |STRLEN |sv_len |NULLOK SV* sv +Apd |STRLEN |sv_len_utf8 |NULLOK SV* sv Apd |void |sv_magic |NN SV* sv|SV* obj|int how|const char* name \ |I32 namlen Apd |MAGIC *|sv_magicext |NN SV* sv|SV* obj|int how|const MGVTBL *vtbl \ @@ -775,8 +775,8 @@ ApdaR |SV* |sv_mortalcopy |NULLOK SV* oldsv ApdR |SV* |sv_newmortal Apd |SV* |sv_newref |NULLOK SV* sv Ap |char* |sv_peek |SV* sv -Apd |void |sv_pos_u2b |SV* sv|NN I32* offsetp|I32* lenp -Apd |void |sv_pos_b2u |SV* sv|NN I32* offsetp +Apd |void |sv_pos_u2b |NULLOK SV* sv|NN I32* offsetp|NULLOK I32* lenp +Apd |void |sv_pos_b2u |NULLOK SV* sv|NN I32* offsetp Amdb |char* |sv_pvn_force |SV* sv|STRLEN* lp Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp Apd |char* |sv_pvbyten_force|SV* sv|STRLEN* lp @@ -1311,7 +1311,7 @@ s |I32 |utf16_textfilter|int idx|SV *sv|int maxlen s |I32 |utf16rev_textfilter|int idx|SV *sv|int maxlen #endif # if defined(PERL_CR_FILTER) -s |I32 |cr_textfilter |int idx|SV *sv|int maxlen +s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen # endif #endif @@ -1513,7 +1513,7 @@ np |void |my_swabn |void* ptr|int n Ap |GV* |gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type Ap |GV* |gv_fetchsv|SV *name|I32 flags|I32 sv_type -dpR |bool |is_gv_magical_sv|SV *name|U32 flags +dpR |bool |is_gv_magical_sv|NN SV *name|U32 flags ApR |bool |stashpv_hvname_match|NN const COP *cop|NN const HV *hv diff --git a/gv.c b/gv.c index 7a078e8..e96ab50 100644 --- a/gv.c +++ b/gv.c @@ -427,7 +427,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) nsplit = ++nend; } if (nsplit) { - const char *origname = name; + const char * const origname = name; name = nsplit + 1; if (*nsplit == ':') --nsplit; @@ -462,7 +462,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) gv = gv_autoload4(ostash, name, nend - name, TRUE); } else if (autoload) { - CV* cv = GvCV(gv); + CV* const cv = GvCV(gv); if (!CvROOT(cv) && !CvXSUB(cv)) { GV* stubgv; GV* autogv; @@ -652,7 +652,7 @@ HV* Perl_gv_stashsv(pTHX_ SV *sv, I32 create) { STRLEN len; - const char *ptr = SvPV_const(sv,len); + const char * const ptr = SvPV_const(sv,len); return gv_stashpvn(ptr, len, create); } @@ -665,7 +665,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) { GV * Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) { STRLEN len; - const char *nambeg = SvPV_const(name, len); + const char * const nambeg = SvPV_const(name, len); return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type); } @@ -813,7 +813,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (!stash) { if (add) { - register SV *err = Perl_mess(aTHX_ + SV * const err = Perl_mess(aTHX_ "Global symbol \"%s%s\" requires explicit package name", (sv_type == SVt_PV ? "$" : sv_type == SVt_PVAV ? "@" @@ -882,7 +882,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, break; case 'I': if (strEQ(name2, "SA")) { - AV* av = GvAVn(gv); + AV* const av = GvAVn(gv); GvMULTI_on(gv); sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0); /* NOTE: No support for tied ISA */ @@ -905,7 +905,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, break; case 'O': if (strEQ(name2, "VERLOAD")) { - HV* hv = GvHVn(gv); + HV* const hv = GvHVn(gv); GvMULTI_on(gv); hv_magic(hv, Nullgv, PERL_MAGIC_overload); } @@ -923,8 +923,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, hv = GvHVn(gv); hv_magic(hv, Nullgv, PERL_MAGIC_sig); for (i = 1; i < SIG_SIZE; i++) { - SV ** init; - init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + SV ** const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); if (init) sv_setsv(*init, &PL_sv_undef); PL_psig_ptr[i] = 0; @@ -1027,7 +1026,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, break; case '-': { - AV* av = GvAVn(gv); + AV* const av = GvAVn(gv); sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); goto magicalize; @@ -1044,7 +1043,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case '+': { - AV* av = GvAVn(gv); + AV* const av = GvAVn(gv); sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); /* FALL THROUGH */ @@ -1100,7 +1099,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, break; case ']': { - SV *sv = GvSV(gv); + SV * const sv = GvSV(gv); if (!sv_derived_from(PL_patchlevel, "version")) (void *)upg_version(PL_patchlevel); GvSV(gv) = vnumify(PL_patchlevel); @@ -1884,7 +1883,8 @@ pointers returned by SvPV. bool Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags) { - (void)flags; + PERL_UNUSED_ARG(flags); + if (len > 1) { const char * const name1 = name + 1; switch (*name) { diff --git a/handy.h b/handy.h index 0a2c50e..09c8c79 100644 --- a/handy.h +++ b/handy.h @@ -629,7 +629,7 @@ hopefully catches attempts to access uninitialized memory. #ifdef PERL_POISON #define Safefree(d) \ - (d ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0) + ((d) ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0) #else #define Safefree(d) safefree((Malloc_t)(d)) #endif diff --git a/hv.c b/hv.c index b3c6b2f..f4c5422 100644 --- a/hv.c +++ b/hv.c @@ -114,11 +114,10 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) void Perl_free_tied_hv_pool(pTHX) { - HE *ohe; HE *he = PL_hv_fetch_ent_mh; while (he) { + HE * const ohe = he; Safefree(HeKEY_hek(he)); - ohe = he; he = HeNEXT(he); del_HE(ohe); } @@ -130,7 +129,8 @@ HEK * Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) { HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); - (void)param; + + PERL_UNUSED_ARG(param); if (shared) { /* We already shared this hash key. */ @@ -270,7 +270,7 @@ SV** Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash, int flags) { - HE *hek = hv_fetch_common (hv, NULL, key, klen, flags, + HE * const hek = hv_fetch_common (hv, NULL, key, klen, flags, (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); return hek ? &HeVAL(hek) : NULL; } @@ -515,10 +515,9 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } /* ISFETCH */ else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - SV* svret; /* I don't understand why hv_exists_ent has svret and sv, whereas hv_exists only had one. */ - svret = sv_newmortal(); + SV * const svret = sv_newmortal(); sv = sv_newmortal(); if (keysv || is_utf8) { @@ -543,7 +542,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { /* XXX This code isn't UTF8 clean. */ - const char *keysave = key; + char * const keysave = key; /* Will need to free this, so set FREEKEY flag. */ key = savepvn(key,klen); key = (const char*)strupr((char*)key); @@ -632,7 +631,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } if (is_utf8) { - const char *keysave = key; + char * const keysave = key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) flags |= HVhek_UTF8; @@ -749,7 +748,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (!(action & HV_FETCH_ISSTORE) && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { unsigned long len; - char *env = PerlEnv_ENVgetenv_len(key,&len); + const char * const env = PerlEnv_ENVgetenv_len(key,&len); if (env) { sv = newSVpvn(env,len); SvTAINTED_on(sv); @@ -1254,7 +1253,7 @@ S_hsplit(pTHX_ HV *hv) while (entry) { /* We're going to trash this HE's next pointer when we chain it into the new hash below, so store where we go next. */ - HE *next = HeNEXT(entry); + HE * const next = HeNEXT(entry); UV hash; HE **bep; @@ -1389,10 +1388,9 @@ Creates a new HV. The reference count is set to 1. HV * Perl_newHV(pTHX) { - register HV *hv; register XPVHV* xhv; + HV * const hv = (HV*)NEWSV(502,0); - hv = (HV*)NEWSV(502,0); sv_upgrade((SV *)hv, SVt_PVHV); xhv = (XPVHV*)SvANY(hv); SvPOK_off(hv); @@ -1409,7 +1407,7 @@ Perl_newHV(pTHX) HV * Perl_newHVhv(pTHX_ HV *ohv) { - HV *hv = newHV(); + HV * const hv = newHV(); STRLEN hv_max, hv_fill; if (!ohv || (hv_fill = HvFILL(ohv)) == 0) diff --git a/perl.c b/perl.c index 765b7ce..5c3f416 100644 --- a/perl.c +++ b/perl.c @@ -218,6 +218,7 @@ void perl_construct(pTHXx) { dVAR; + PERL_UNUSED_ARG(my_perl); #ifdef MULTIPLICITY init_interp(); PL_perl_destruct_level = 1; @@ -514,14 +515,16 @@ perl_destruct(pTHXx) pid_t child; #endif + PERL_UNUSED_ARG(my_perl); + /* wait for all pseudo-forked children to finish */ PERL_WAIT_FOR_CHILDREN; destruct_level = PL_perl_destruct_level; #ifdef DEBUGGING { - const char *s; - if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) { + const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); + if (s) { const int i = atoi(s); if (destruct_level < i) destruct_level = i; @@ -1392,6 +1395,8 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) int ret; dJMPENV; + PERL_UNUSED_VAR(my_perl); + #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW #ifdef IAMSUID #undef IAMSUID @@ -1409,7 +1414,7 @@ setuid perl scripts securely.\n"); if (!PL_rehash_seed_set) PL_rehash_seed = get_hash_seed(); { - const char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); + const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); if (s && (atoi(s) == 1)) PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n", PL_rehash_seed); @@ -2130,6 +2135,8 @@ perl_run(pTHXx) int ret = 0; dJMPENV; + PERL_UNUSED_ARG(my_perl); + oldscope = PL_scopestack_ix; #ifdef VMS VMSISH_HUSHED = 0; @@ -2529,6 +2536,9 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) POPEVAL(cx); PL_curpm = newpm; LEAVE; + PERL_UNUSED_VAR(newsp); + PERL_UNUSED_VAR(gimme); + PERL_UNUSED_VAR(optype); } JMPENV_POP; } @@ -5137,17 +5147,19 @@ S_my_exit_jump(pTHX) } JMPENV_JUMP(2); + PERL_UNUSED_VAR(gimme); + PERL_UNUSED_VAR(newsp); } static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen) { - const char *p, *nl; - (void)idx; - (void)maxlen; + const char * const p = SvPVX_const(PL_e_script); + const char *nl = strchr(p, '\n'); + + PERL_UNUSED_ARG(idx); + PERL_UNUSED_ARG(maxlen); - p = SvPVX_const(PL_e_script); - nl = strchr(p, '\n'); nl = (nl) ? nl+1 : SvEND(PL_e_script); if (nl-p == 0) { filter_del(read_e_script); diff --git a/pp_ctl.c b/pp_ctl.c index d0e2ef6..fbd533e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2061,7 +2061,7 @@ PP(pp_last) PMOP *newpm; SV **mark; SV *sv = Nullsv; - PERL_UNUSED_VAR(optype); + if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); @@ -2077,7 +2077,6 @@ PP(pp_last) dounwind(cxix); POPBLOCK(cx,newpm); - PERL_UNUSED_VAR(optype); cxstack_ix++; /* temporarily protect top context */ mark = newsp; switch (CxTYPE(cx)) { @@ -2135,6 +2134,8 @@ PP(pp_last) PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); + PERL_UNUSED_VAR(optype); + PERL_UNUSED_VAR(gimme); return nextop; } @@ -2271,7 +2272,7 @@ PP(pp_goto) static const char must_have_label[] = "goto must have label"; if (PL_op->op_flags & OPf_STACKED) { - SV *sv = POPs; + SV * const sv = POPs; /* This egregious kludge implements goto &subroutine */ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { @@ -2767,7 +2768,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) dVAR; dSP; /* Make POPBLOCK work. */ PERL_CONTEXT *cx; SV **newsp; - I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */ + I32 gimme; I32 optype; OP dummy; OP *rop; @@ -2787,7 +2788,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) CopSTASH_set(&PL_compiling, PL_curstash); } if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { - SV *sv = sv_newmortal(); + SV * const sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]", code, (unsigned long)++PL_evalseq, CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); @@ -2842,6 +2843,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) #ifdef OP_IN_REGISTER op = PL_opsave; #endif + PERL_UNUSED_VAR(newsp); + PERL_UNUSED_VAR(optype); + return rop; } @@ -2945,8 +2949,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) sv_setpvn(ERRSV,"",0); if (yyparse() || PL_error_count || !PL_eval_root) { SV **newsp; /* Used by POPBLOCK. */ - PERL_CONTEXT *cx = &cxstack[cxstack_ix]; + PERL_CONTEXT *cx = &cxstack[cxstack_ix]; I32 optype = 0; /* Might be reset by POPEVAL. */ + const char *msg; PL_op = saveop; if (PL_eval_root) { @@ -2960,8 +2965,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) } lex_end(); LEAVE; + + msg = SvPVx_nolen_const(ERRSV); if (optype == OP_REQUIRE) { - const char* const msg = SvPVx_nolen_const(ERRSV); const SV * const nsv = cx->blk_eval.old_namesv; (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), &PL_sv_undef, 0); @@ -2969,19 +2975,17 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) *msg ? msg : "Unknown error\n"); } else if (startop) { - const char* msg = SvPVx_nolen_const(ERRSV); - POPBLOCK(cx,PL_curpm); POPEVAL(cx); Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n")); } else { - const char* msg = SvPVx_nolen_const(ERRSV); if (!*msg) { sv_setpv(ERRSV, "Compilation error"); } } + PERL_UNUSED_VAR(newsp); RETPUSHUNDEF; } CopLINE_set(&PL_compiling, 0); @@ -3037,14 +3041,14 @@ S_doopen_pm(pTHX_ const char *name, const char *mode) PerlIO *fp; if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) { - SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c'); + SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c'); const char * const pmc = SvPV_nolen_const(pmcsv); - Stat_t pmstat; Stat_t pmcstat; if (PerlLIO_stat(pmc, &pmcstat) < 0) { fp = PerlIO_open(name, mode); } else { + Stat_t pmstat; if (PerlLIO_stat(name, &pmstat) < 0 || pmstat.st_mtime < pmcstat.st_mtime) { @@ -3589,6 +3593,7 @@ PP(pp_leavetry) POPBLOCK(cx,newpm); POPEVAL(cx); + PERL_UNUSED_VAR(optype); TAINT_NOT; if (gimme == G_VOID) diff --git a/pp_hot.c b/pp_hot.c index 8df8e09..1fba457 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2797,6 +2797,7 @@ PP(pp_entersub) return NORMAL; } + /*NOTREACHED*/ assert (0); /* Cannot get here. */ /* This is deliberately moved here as spaghetti code to keep it out of the hot path. */ diff --git a/proto.h b/proto.h index 7b060cf..42cf557 100644 --- a/proto.h +++ b/proto.h @@ -499,7 +499,8 @@ PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd) __attribute__warn_unused_result__; PERL_CALLCONV bool Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags) - __attribute__warn_unused_result__; + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); PERL_CALLCONV I32 Perl_is_lvalue_sub(pTHX) __attribute__warn_unused_result__; @@ -1538,12 +1539,8 @@ PERL_CALLCONV int Perl_sv_isa(pTHX_ SV* sv, const char* name) PERL_CALLCONV int Perl_sv_isobject(pTHX_ SV* sv) __attribute__nonnull__(pTHX_1); -PERL_CALLCONV STRLEN Perl_sv_len(pTHX_ SV* sv) - __attribute__nonnull__(pTHX_1); - -PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv) - __attribute__nonnull__(pTHX_1); - +PERL_CALLCONV STRLEN Perl_sv_len(pTHX_ SV* sv); +PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv); PERL_CALLCONV void Perl_sv_magic(pTHX_ SV* sv, SV* obj, int how, const char* name, I32 namlen) __attribute__nonnull__(pTHX_1); @@ -2980,7 +2977,8 @@ PERL_CALLCONV void Perl_my_swabn(void* ptr, int n); PERL_CALLCONV GV* Perl_gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, I32 flags, I32 sv_type); PERL_CALLCONV GV* Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type); PERL_CALLCONV bool Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags) - __attribute__warn_unused_result__; + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); PERL_CALLCONV bool Perl_stashpv_hvname_match(pTHX_ const COP *cop, const HV *hv) diff --git a/regexec.c b/regexec.c index fa3eb1b..f705021 100644 --- a/regexec.c +++ b/regexec.c @@ -1650,7 +1650,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * GET_RE_DEBUG_FLAGS_DECL; - (void)data; /* Currently unused */ + PERL_UNUSED_ARG(data); RX_MATCH_UTF8_set(prog,do_utf8); PL_regcc = 0; @@ -4900,7 +4900,7 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) static void restore_pos(pTHX_ void *arg) { - (void)arg; /* unused */ + PERL_UNUSED_ARG(arg); if (PL_reg_eval_set) { if (PL_reg_oldsaved) { PL_reg_re->subbeg = PL_reg_oldsaved; @@ -4919,8 +4919,8 @@ restore_pos(pTHX_ void *arg) STATIC void S_to_utf8_substr(pTHX_ register regexp *prog) { - SV* sv; if (prog->float_substr && !prog->float_utf8) { + SV* sv; prog->float_utf8 = sv = newSVsv(prog->float_substr); sv_utf8_upgrade(sv); if (SvTAIL(prog->float_substr)) @@ -4929,6 +4929,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog) prog->check_utf8 = sv; } if (prog->anchored_substr && !prog->anchored_utf8) { + SV* sv; prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr); sv_utf8_upgrade(sv); if (SvTAIL(prog->anchored_substr)) @@ -4941,8 +4942,8 @@ S_to_utf8_substr(pTHX_ register regexp *prog) STATIC void S_to_byte_substr(pTHX_ register regexp *prog) { - SV* sv; if (prog->float_utf8 && !prog->float_substr) { + SV* sv; prog->float_substr = sv = newSVsv(prog->float_utf8); if (sv_utf8_downgrade(sv, TRUE)) { if (SvTAIL(prog->float_utf8)) @@ -4955,6 +4956,7 @@ S_to_byte_substr(pTHX_ register regexp *prog) prog->check_substr = sv; } if (prog->anchored_utf8 && !prog->anchored_substr) { + SV* sv; prog->anchored_substr = sv = newSVsv(prog->anchored_utf8); if (sv_utf8_downgrade(sv, TRUE)) { if (SvTAIL(prog->anchored_utf8)) diff --git a/sv.c b/sv.c index 45da2bc..26e780e 100644 --- a/sv.c +++ b/sv.c @@ -6023,7 +6023,7 @@ Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp) STRLEN *cache = 0; const U8 *s = start; I32 uoffset = *offsetp; - const U8 *send = s + len; + const U8 * const send = s + len; MAGIC *mg = 0; bool found = FALSE; @@ -6125,7 +6125,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) * is made as in S_utf8_mg_pos(), namely that * walking backward is twice slower than * walking forward. */ - STRLEN forw = *offsetp; + const STRLEN forw = *offsetp; STRLEN backw = cache[1] - *offsetp; if (!(forw < 2 * backw)) { @@ -6258,7 +6258,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) if (SvUTF8(sv1)) { /* sv1 is the UTF-8 one, * if is equal it must be downgrade-able */ - char *pv = (char*)bytes_from_utf8((const U8*)pv1, + char * const pv = (char*)bytes_from_utf8((const U8*)pv1, &cur1, &is_utf8); if (pv != pv1) pv1 = tpv = pv; @@ -6266,7 +6266,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) else { /* sv2 is the UTF-8 one, * if is equal it must be downgrade-able */ - char *pv = (char *)bytes_from_utf8((const U8*)pv2, + char * const pv = (char *)bytes_from_utf8((const U8*)pv2, &cur2, &is_utf8); if (pv != pv2) pv2 = tpv = pv; diff --git a/toke.c b/toke.c index 76bfc9a..efdd214 100644 --- a/toke.c +++ b/toke.c @@ -283,7 +283,7 @@ S_tokereport(pTHX_ const char* s, I32 rv) const char *name = Nullch; enum token_type type = TOKENTYPE_NONE; const struct debug_tokens *p; - SV* report = newSVpvn("<== ", 4); + SV* const report = newSVpvn("<== ", 4); for (p = debug_tokens; p->token; p++) { if (p->token == (int)rv) { @@ -375,8 +375,8 @@ S_ao(pTHX_ int toketype) STATIC void S_no_op(pTHX_ const char *what, char *s) { - char *oldbp = PL_bufptr; - bool is_first = (PL_oldbufptr == PL_linestart); + char * const oldbp = PL_bufptr; + const bool is_first = (PL_oldbufptr == PL_linestart); if (!s) s = oldbp; @@ -419,7 +419,7 @@ S_missingterm(pTHX_ char *s) char tmpbuf[3]; char q; if (s) { - char *nl = strrchr(s,'\n'); + char * const nl = strrchr(s,'\n'); if (nl) *nl = '\0'; } @@ -492,7 +492,7 @@ static void strip_return(SV *sv) { register const char *s = SvPVX_const(sv); - register const char *e = s + SvCUR(sv); + register const char * const e = s + SvCUR(sv); /* outer loop optimized to do nothing if there are no CR-LFs */ while (s < e) { if (*s++ == '\r' && *s == '\n') { @@ -778,7 +778,7 @@ S_skipspace(pTHX_ register char *s) * so store the line into the debugger's array of lines */ if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(85,0); + SV * const sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr); @@ -812,7 +812,7 @@ S_check_uni(pTHX) if ((t = strchr(s, '(')) && t < PL_bufptr) return; if (ckWARN_d(WARN_AMBIGUOUS)){ - char ch = *s; + const char ch = *s; *s = '\0'; Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Warning: Use of \"%s\" without parentheses is ambiguous", @@ -880,7 +880,7 @@ S_force_next(pTHX_ I32 type) STATIC SV * S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) { - SV *sv = newSVpvn(start,len); + SV * const sv = newSVpvn(start,len); if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len)) SvUTF8_on(sv); return sv; @@ -972,7 +972,7 @@ Perl_str_to_version(pTHX_ SV *sv) NV nshift = 1.0; STRLEN len; const char *start = SvPV_const(sv,len); - const char *end = start + len; + const char * const end = start + len; const bool utf = SvUTF8(sv) ? TRUE : FALSE; while (start < end) { STRLEN skip; @@ -1233,7 +1233,7 @@ S_sublex_done(pTHX) { dVAR; if (!PL_lex_starts++) { - SV *sv = newSVpvn("",0); + SV * const sv = newSVpvn("",0); if (SvUTF8(PL_linestr)) SvUTF8_on(sv); PL_expect = XOPERATOR; @@ -1391,7 +1391,7 @@ S_scan_const(pTHX_ char *start) I32 max; /* last character in range */ if (has_utf8) { - char *c = (char*)utf8_hop((U8*)d, -1); + char * const c = (char*)utf8_hop((U8*)d, -1); char *e = d++; while (e-- > c) *(e + 1) = *e; @@ -1580,7 +1580,7 @@ S_scan_const(pTHX_ char *start) case 'x': ++s; if (*s == '{') { - char* e = strchr(s, '}'); + char* const e = strchr(s, '}'); I32 flags = PERL_SCAN_ALLOW_UNDERSCORES | PERL_SCAN_DISALLOW_PREFIX; STRLEN len; @@ -1629,7 +1629,7 @@ S_scan_const(pTHX_ char *start) } } if (hicount) { - STRLEN offset = d - SvPVX_const(sv); + const STRLEN offset = d - SvPVX_const(sv); U8 *src, *dst; d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset; src = (U8 *)d - 1; @@ -1637,7 +1637,7 @@ S_scan_const(pTHX_ char *start) d += hicount; while (src >= (const U8 *)SvPVX_const(sv)) { if (!NATIVE_IS_INVARIANT(*src)) { - U8 ch = NATIVE_TO_ASCII(*src); + const U8 ch = NATIVE_TO_ASCII(*src); *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch); *dst-- = (U8)UTF8_EIGHT_BIT_HI(ch); } @@ -1719,7 +1719,7 @@ S_scan_const(pTHX_ char *start) } #endif if (!has_utf8 && SvUTF8(res)) { - const char *ostart = SvPVX_const(sv); + const char * const ostart = SvPVX_const(sv); SvCUR_set(sv, d - ostart); SvPOK_on(sv); *d = '\0'; @@ -1730,7 +1730,7 @@ S_scan_const(pTHX_ char *start) has_utf8 = TRUE; } if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ - const char *odest = SvPVX_const(sv); + const char * const odest = SvPVX_const(sv); SvGROW(sv, (SvLEN(sv) + len - (e - s + 4))); d = SvPVX(sv) + (d - odest); @@ -1794,12 +1794,12 @@ S_scan_const(pTHX_ char *start) and then encode the next character */ if ((has_utf8 || this_utf8) && !NATIVE_IS_INVARIANT((U8)(*s))) { STRLEN len = 1; - UV uv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s); - STRLEN need = UNISKIP(NATIVE_TO_UNI(uv)); + const UV uv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s); + const STRLEN need = UNISKIP(NATIVE_TO_UNI(uv)); s += len; if (need > len) { /* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */ - STRLEN off = d - SvPVX_const(sv); + const STRLEN off = d - SvPVX_const(sv); d = SvGROW(sv, SvLEN(sv) + (need-len)) + off; } d = (char*)uvchr_to_utf8((U8*)d, uv); @@ -1911,7 +1911,7 @@ S_intuit_more(pTHX_ register char *s) int weight = 2; /* let's weigh the evidence */ char seen[256]; unsigned char un_char = 255, last_un_char; - const char *send = strchr(s,']'); + const char * const send = strchr(s,']'); char tmpbuf[sizeof PL_tokenbuf * 4]; if (!send) /* has to be an expression */ @@ -2101,7 +2101,7 @@ STATIC const char* S_incl_perldb(pTHX) { if (PL_perldb) { - const char *pdb = PerlEnv_getenv("PERL5DB"); + const char * const pdb = PerlEnv_getenv("PERL5DB"); if (pdb) return pdb; @@ -2632,7 +2632,7 @@ Perl_yylex(pTHX) PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(85,0); + SV * const sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); @@ -2719,7 +2719,7 @@ Perl_yylex(pTHX) } while (PL_doextract); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(85,0); + SV * const sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); @@ -2775,7 +2775,7 @@ Perl_yylex(pTHX) STRLEN blen; STRLEN llen; const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen); - const char *lstart = SvPV_const(x,llen); + const char * const lstart = SvPV_const(x,llen); if (llen < blen) { bstart += blen - llen; if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') { @@ -2874,7 +2874,7 @@ Perl_yylex(pTHX) const bool switches_done = PL_doswitches; do { if (*d == 'M' || *d == 'm' || *d == 'C') { - const char *m = d; + const char * const m = d; while (*d && !isSPACE(*d)) d++; Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); -- 1.8.3.1