diff options
| -rw-r--r-- | deb.c | 5 | ||||
| -rw-r--r-- | doio.c | 2 | ||||
| -rw-r--r-- | dump.c | 32 | ||||
| -rw-r--r-- | embed.fnc | 9 | ||||
| -rw-r--r-- | embed.h | 14 | ||||
| -rw-r--r-- | hv.c | 15 | ||||
| -rw-r--r-- | hv.h | 4 | ||||
| -rw-r--r-- | locale.c | 2 | ||||
| -rw-r--r-- | mg.c | 64 | ||||
| -rw-r--r-- | op.c | 33 | ||||
| -rw-r--r-- | op.h | 5 | ||||
| -rw-r--r-- | pp.c | 52 | ||||
| -rw-r--r-- | pp_ctl.c | 57 | ||||
| -rw-r--r-- | pp_hot.c | 21 | ||||
| -rw-r--r-- | pp_pack.c | 6 | ||||
| -rw-r--r-- | pp_sort.c | 2 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rw-r--r-- | proto.h | 21 | ||||
| -rw-r--r-- | regcomp.c | 5 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | taint.c | 2 | ||||
| -rw-r--r-- | toke.c | 37 | ||||
| -rw-r--r-- | utf8.c | 30 | ||||
| -rw-r--r-- | util.c | 13 |
24 files changed, 225 insertions, 210 deletions
@@ -160,7 +160,7 @@ Perl_debstack(pTHX) #ifdef DEBUGGING -static const char * si_names[] = { +static const char * const si_names[] = { "UNKNOWN", "UNDEF", "MAIN", @@ -182,7 +182,7 @@ void Perl_deb_stack_all(pTHX) { #ifdef DEBUGGING - I32 ix, si_ix; + I32 si_ix; const PERL_SI *si; /* rewind to start of chain */ @@ -195,6 +195,7 @@ Perl_deb_stack_all(pTHX) { const int si_name_ix = si->si_type+1; /* -1 is a valid index */ const char * const si_name = (si_name_ix>= sizeof(si_names)) ? "????" : si_names[si_name_ix]; + I32 ix; PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n", (IV)si_ix, si_name); @@ -1320,11 +1320,11 @@ Perl_my_stat(pTHX) } } -static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; I32 Perl_my_lstat(pTHX) { + static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; dSP; SV *sv; if (PL_op->op_flags & OPf_REF) { @@ -24,6 +24,8 @@ #define PERL_IN_DUMP_C #include "perl.h" #include "regcomp.h" +#include "proto.h" + #define Sequence PL_op_sequence @@ -402,7 +404,7 @@ Perl_pmop_dump(pTHX_ PMOP *pm) /* An op sequencer. We visit the ops in the order they're to execute. */ STATIC void -sequence(pTHX_ register const OP *o) +S_sequence(pTHX_ register const OP *o) { dVAR; SV *op; @@ -456,7 +458,7 @@ sequence(pTHX_ register const OP *o) hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0); for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next) ; - sequence(aTHX_ l); + sequence(l); break; case OP_ENTERLOOP: @@ -464,13 +466,13 @@ sequence(pTHX_ register const OP *o) hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0); for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next) ; - sequence(aTHX_ l); + sequence(l); for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next) ; - sequence(aTHX_ l); + sequence(l); for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next) ; - sequence(aTHX_ l); + sequence(l); break; case OP_QR: @@ -479,7 +481,7 @@ sequence(pTHX_ register const OP *o) hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0); for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next) ; - sequence(aTHX_ l); + sequence(l); break; case OP_HELEM: @@ -494,7 +496,7 @@ sequence(pTHX_ register const OP *o) } STATIC UV -sequence_num(pTHX_ const OP *o) +S_sequence_num(pTHX_ const OP *o) { dVAR; SV *op, @@ -513,10 +515,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) { dVAR; UV seq; - sequence(aTHX_ o); + sequence(o); Perl_dump_indent(aTHX_ level, file, "{\n"); level++; - seq = sequence_num(aTHX_ o); + seq = sequence_num(o); if (seq) PerlIO_printf(file, "%-4"UVf, seq); else @@ -526,7 +528,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) (int)(PL_dumpindent*level-4), "", OP_NAME(o)); if (o->op_next) PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n", - sequence_num(aTHX_ o->op_next)); + sequence_num(o->op_next)); else PerlIO_printf(file, "DONE\n"); if (o->op_targ) { @@ -800,17 +802,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) case OP_ENTERLOOP: Perl_dump_indent(aTHX_ level, file, "REDO ===> "); if (cLOOPo->op_redoop) - PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop)); + PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_redoop)); else PerlIO_printf(file, "DONE\n"); Perl_dump_indent(aTHX_ level, file, "NEXT ===> "); if (cLOOPo->op_nextop) - PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop)); + PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_nextop)); else PerlIO_printf(file, "DONE\n"); Perl_dump_indent(aTHX_ level, file, "LAST ===> "); if (cLOOPo->op_lastop) - PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop)); + PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_lastop)); else PerlIO_printf(file, "DONE\n"); break; @@ -822,7 +824,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) case OP_AND: Perl_dump_indent(aTHX_ level, file, "OTHER ===> "); if (cLOGOPo->op_other) - PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other)); + PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOGOPo->op_other)); else PerlIO_printf(file, "DONE\n"); break; @@ -1470,7 +1472,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); if (CvSTART(sv)) - Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv))); + Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv))); Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); if (CvROOT(sv) && dumpops) do_op_dump(level+1, file, CvROOT(sv)); @@ -1142,6 +1142,7 @@ s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit rs |void |run_body |I32 oldscope s |void |call_body |NN const OP *myop|bool is_eval s |void* |call_list_body |NN CV *cv +s |SV * |incpush_if_exists|NN SV *dir #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -1161,6 +1162,7 @@ s |const char *|group_end |NN const char *pat|NN const char *patend|char ender sR |const char *|get_num |NN const char *ppat|NN I32 *lenptr ns |bool |need_utf8 |NN const char *pat|NN const char *patend ns |char |first_symbol |NN const char *pat|NN const char *patend +sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed #endif #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) @@ -1178,6 +1180,7 @@ s |void |save_lines |NULLOK AV *array|NN SV *sv sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq sR |PerlIO *|doopen_pm |NN const char *name|NN const char *mode sR |bool |path_is_absolute|NN const char *name +sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) @@ -1271,6 +1274,8 @@ Es |void |to_byte_substr |NN regexp * prog #if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) s |CV* |deb_curcv |I32 ix s |void |debprof |NN const OP *o +s |void |sequence |NULLOK const OP *o +s |UV |sequence_num |NULLOK const OP *o #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -1347,7 +1352,7 @@ sR |I32 |sublex_push sR |I32 |sublex_start sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|STRLEN append sR |HV * |find_in_my_stash|NN const char *pkgname|I32 len -sR |char * |tokenize_use |int|NN char* +sR |char * |tokenize_use |int is_use|NN char* s |SV* |new_constant |NULLOK const char *s|STRLEN len|NN const char *key|NN SV *sv \ |NULLOK SV *pv|NULLOK const char *type # if defined(DEBUGGING) @@ -1358,6 +1363,7 @@ s |void |depcom s |const char*|incl_perldb # if defined(PERL_CR_FILTER) s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen +s |void |strip_return |NN SV *sv # endif #endif @@ -1377,6 +1383,7 @@ s |SV* |mess_alloc s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \ |NULLOK STRLEN *msglen|NULLOK I32* utf8 s |void |vdie_common |NULLOK const char *message|STRLEN msglen|I32 utf8 +sr |char * |write_no_mem #endif #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) @@ -1160,6 +1160,7 @@ #define run_body S_run_body #define call_body S_call_body #define call_list_body S_call_list_body +#define incpush_if_exists S_incpush_if_exists #endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -1180,6 +1181,7 @@ #define get_num S_get_num #define need_utf8 S_need_utf8 #define first_symbol S_first_symbol +#define sv_exp_grow S_sv_exp_grow #endif #endif #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) @@ -1198,6 +1200,7 @@ #define doeval S_doeval #define doopen_pm S_doopen_pm #define path_is_absolute S_path_is_absolute +#define run_user_filter S_run_user_filter #endif #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) @@ -1300,6 +1303,8 @@ #ifdef PERL_CORE #define deb_curcv S_deb_curcv #define debprof S_debprof +#define sequence S_sequence +#define sequence_num S_sequence_num #endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -1393,6 +1398,7 @@ # if defined(PERL_CR_FILTER) #ifdef PERL_CORE #define cr_textfilter S_cr_textfilter +#define strip_return S_strip_return #endif # endif #endif @@ -1414,6 +1420,7 @@ #define mess_alloc S_mess_alloc #define vdie_croak_common S_vdie_croak_common #define vdie_common S_vdie_common +#define write_no_mem S_write_no_mem #endif #endif #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) @@ -3165,6 +3172,7 @@ #define run_body(a) S_run_body(aTHX_ a) #define call_body(a,b) S_call_body(aTHX_ a,b) #define call_list_body(a) S_call_list_body(aTHX_ a) +#define incpush_if_exists(a) S_incpush_if_exists(aTHX_ a) #endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -3185,6 +3193,7 @@ #define get_num(a,b) S_get_num(aTHX_ a,b) #define need_utf8 S_need_utf8 #define first_symbol S_first_symbol +#define sv_exp_grow(a,b) S_sv_exp_grow(aTHX_ a,b) #endif #endif #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) @@ -3203,6 +3212,7 @@ #define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d) #define doopen_pm(a,b) S_doopen_pm(aTHX_ a,b) #define path_is_absolute(a) S_path_is_absolute(aTHX_ a) +#define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c) #endif #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) @@ -3304,6 +3314,8 @@ #ifdef PERL_CORE #define deb_curcv(a) S_deb_curcv(aTHX_ a) #define debprof(a) S_debprof(aTHX_ a) +#define sequence(a) S_sequence(aTHX_ a) +#define sequence_num(a) S_sequence_num(aTHX_ a) #endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -3399,6 +3411,7 @@ # if defined(PERL_CR_FILTER) #ifdef PERL_CORE #define cr_textfilter(a,b,c) S_cr_textfilter(aTHX_ a,b,c) +#define strip_return(a) S_strip_return(aTHX_ a) #endif # endif #endif @@ -3420,6 +3433,7 @@ #define mess_alloc() S_mess_alloc(aTHX) #define vdie_croak_common(a,b,c,d) S_vdie_croak_common(aTHX_ a,b,c,d) #define vdie_common(a,b,c) S_vdie_common(aTHX_ a,b,c) +#define write_no_mem() S_write_no_mem(aTHX) #endif #endif #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) @@ -65,7 +65,7 @@ STATIC HE* S_new_he(pTHX) { HE* he; - void **root = &PL_body_roots[HE_SVSLOT]; + void ** const root = &PL_body_roots[HE_SVSLOT]; LOCK_SV_MUTEX; if (!*root) @@ -490,7 +490,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (isLOWER(key[i])) { /* Would be nice if we had a routine to do the copy and upercase in a single pass through. */ - const char *nkey = strupr(savepvn(key,klen)); + const char * const nkey = strupr(savepvn(key,klen)); /* Note that this fetch is for nkey (the uppercased key) whereas the store is for key (the original) */ entry = hv_fetch_common(hv, Nullsv, nkey, klen, @@ -1785,14 +1785,12 @@ value, you can get it through the macro C<HvFILL(tb)>. I32 Perl_hv_iterinit(pTHX_ HV *hv) { - HE *entry; - if (!hv) Perl_croak(aTHX_ "Bad hash"); if (SvOOK(hv)) { struct xpvhv_aux *iter = HvAUX(hv); - entry = iter->xhv_eiter; /* HvEITER(hv) */ + HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ HvLAZYDEL_off(hv); hv_free_ent(hv, entry); @@ -2053,7 +2051,7 @@ Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen) { if (HeKLEN(entry) == HEf_SVKEY) { STRLEN len; - char *p = SvPV(HeKEY_sv(entry), len); + char * const p = SvPV(HeKEY_sv(entry), len); *retlen = len; return p; } @@ -2117,8 +2115,9 @@ operation. SV * Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen) { - HE *he; - if ( (he = hv_iternext_flags(hv, 0)) == NULL) + HE * const he = hv_iternext_flags(hv, 0); + + if (!he) return NULL; *key = hv_iterkey(he, retlen); return hv_iterval(hv, he); @@ -103,7 +103,7 @@ typedef struct { #endif #define PERL_HASH(hash,str,len) \ STMT_START { \ - register const char *s_PeRlHaSh_tmp = str; \ + register const char * const s_PeRlHaSh_tmp = str; \ register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \ register I32 i_PeRlHaSh = len; \ register U32 hash_PeRlHaSh = PERL_HASH_SEED; \ @@ -121,7 +121,7 @@ typedef struct { #ifdef PERL_HASH_INTERNAL_ACCESS #define PERL_HASH_INTERNAL(hash,str,len) \ STMT_START { \ - register const char *s_PeRlHaSh_tmp = str; \ + register const char * const s_PeRlHaSh_tmp = str; \ register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \ register I32 i_PeRlHaSh = len; \ register U32 hash_PeRlHaSh = PL_rehash_seed; \ @@ -337,7 +337,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) if (setlocale_failure) { char *p; - bool locwarn = (printwarn > 1 || + const bool locwarn = (printwarn > 1 || (printwarn && (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p)))); @@ -485,14 +485,15 @@ Perl_mg_free(pTHX_ SV *sv) U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) { - register const REGEXP *rx; PERL_UNUSED_ARG(sv); - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { - if (mg->mg_obj) /* @+ */ - return rx->nparens; - else /* @- */ - return rx->lastparen; + if (PL_curpm) { + register const REGEXP * const rx = PM_GETRE(PL_curpm); + if (rx) { + return mg->mg_obj + ? rx->nparens /* @+ */ + : rx->lastparen; /* @- */ + } } return (U32)-1; @@ -501,32 +502,33 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) { - register REGEXP *rx; - - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { - register const I32 paren = mg->mg_len; - register I32 s; - register I32 t; - if (paren < 0) - return 0; - if (paren <= (I32)rx->nparens && - (s = rx->startp[paren]) != -1 && - (t = rx->endp[paren]) != -1) - { - register I32 i; - if (mg->mg_obj) /* @+ */ - i = t; - else /* @- */ - i = s; + if (PL_curpm) { + register const REGEXP * const rx = PM_GETRE(PL_curpm); + if (rx) { + register const I32 paren = mg->mg_len; + register I32 s; + register I32 t; + if (paren < 0) + return 0; + if (paren <= (I32)rx->nparens && + (s = rx->startp[paren]) != -1 && + (t = rx->endp[paren]) != -1) + { + register I32 i; + if (mg->mg_obj) /* @+ */ + i = t; + else /* @- */ + i = s; + + if (i > 0 && RX_MATCH_UTF8(rx)) { + const char * const b = rx->subbeg; + if (b) + i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i)); + } - if (i > 0 && RX_MATCH_UTF8(rx)) { - const char * const b = rx->subbeg; - if (b) - i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i)); + sv_setiv(sv, i); } - - sv_setiv(sv, i); - } + } } return 0; } @@ -1158,7 +1160,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) static void restore_sigmask(pTHX_ SV *save_sv) { - const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv ); + const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv ); (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0); } #endif @@ -1520,7 +1520,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) STATIC OP * S_dup_attrlist(pTHX_ OP *o) { - OP *rop = Nullop; + OP *rop; /* An attrlist is either a simple OP_CONST or an OP_LIST with kids, * where the first kid is OP_PUSHMARK and the remaining ones @@ -1530,6 +1530,7 @@ S_dup_attrlist(pTHX_ OP *o) rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc(cSVOPo->op_sv)); else { assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS)); + rop = Nullop; for (o = cLISTOPo->op_first; o; o=o->op_sibling) { if (o->op_type == OP_CONST) rop = append_elem(OP_LIST, rop, @@ -1734,7 +1735,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs) { - OP *rops = Nullop; + OP *rops; int maybe_scalar = 0; /* [perl #17376]: this appears to be premature, and results in code such as @@ -1749,6 +1750,7 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) #endif if (attrs) SAVEFREEOP(attrs); + rops = Nullop; o = my_kid(o, attrs, &rops); if (rops) { if (maybe_scalar && o->op_type == OP_PADSV) { @@ -2772,7 +2774,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) cLISTOPx(expr)->op_first->op_sibling == cLISTOPx(expr)->op_last) { /* convert single element list to element */ - OP* oe = expr; + OP* const oe = expr; expr = cLISTOPx(oe)->op_first->op_sibling; cLISTOPx(oe)->op_first->op_sibling = Nullop; cLISTOPx(oe)->op_last = Nullop; @@ -4493,7 +4495,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (name || aname) { const char *s; - const char *tname = (name ? name : aname); + const char * const tname = (name ? name : aname); if (PERLDB_SUBLINE && PL_curstash != PL_debstash) { SV * const sv = NEWSV(0,0); @@ -4745,13 +4747,11 @@ void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { register CV *cv; - GV *gv; - if (o) - gv = gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM); - else - gv = gv_fetchpv("STDOUT", TRUE, SVt_PVFM); - + GV * const gv = o + ? gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM) + : gv_fetchpv("STDOUT", TRUE, SVt_PVFM); + #ifdef GV_UNIQUE_CHECK if (GvUNIQUE(gv)) { Perl_croak(aTHX_ "Bad symbol for form (GV is unique)"); @@ -4977,7 +4977,7 @@ Perl_ck_bitop(pTHX_ OP *o) OP * Perl_ck_concat(pTHX_ OP *o) { - const OP *kid = cUNOPo->op_first; + const OP * const kid = cUNOPo->op_first; if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) && !(kUNOP->op_first->op_flags & OPf_MOD)) o->op_flags |= OPf_STACKED; @@ -5164,7 +5164,7 @@ OP * Perl_ck_rvconst(pTHX_ register OP *o) { dVAR; - SVOP *kid = (SVOP*)cUNOPo->op_first; + SVOP * const kid = (SVOP*)cUNOPo->op_first; o->op_private |= (PL_hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { @@ -5174,7 +5174,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) /* Is it a constant from cv_const_sv()? */ if (SvROK(kidsv) && SvREADONLY(kidsv)) { - SV *rsv = SvRV(kidsv); + SV * const rsv = SvRV(kidsv); const int svtype = SvTYPE(rsv); const char *badtype = Nullch; @@ -5406,7 +5406,7 @@ Perl_ck_fun(pTHX_ OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(OP_GV, 0, + OP * const newop = newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVIO) ); if (!(o->op_private & 1) && /* if not unop */ kid == cLISTOPo->op_last) @@ -5446,7 +5446,7 @@ Perl_ck_fun(pTHX_ OP *o) else if (kid->op_type == OP_RV2SV && kUNOP->op_first->op_type == OP_GV) { - GV *gv = cGVOPx_gv(kUNOP->op_first); + GV * const gv = cGVOPx_gv(kUNOP->op_first); name = GvNAME(gv); len = GvNAMELEN(gv); } @@ -6349,6 +6349,7 @@ Perl_ck_subr(pTHX_ OP *o) break; case ']': if (contextclass) { + /* XXX We shouldn't be modifying proto, so we can const proto */ char *p = proto; const char s = *p; contextclass = 0; @@ -6605,7 +6606,7 @@ Perl_peep(pTHX_ register OP *o) case OP_PADAV: case OP_GV: if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) { - OP* pop = (o->op_type == OP_PADAV) ? + OP* const pop = (o->op_type == OP_PADAV) ? o->op_next : o->op_next->op_next; IV i; if (pop && pop->op_type == OP_CONST && @@ -289,7 +289,10 @@ struct pmop { #ifdef USE_ITHREADS #define PM_GETRE(o) (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset]))) -#define PM_SETRE(o,r) STMT_START { SV* sv = PL_regex_pad[(o)->op_pmoffset]; sv_setiv(sv, PTR2IV(r)); } STMT_END +#define PM_SETRE(o,r) STMT_START { \ + SV* const sv = PL_regex_pad[(o)->op_pmoffset]; \ + sv_setiv(sv, PTR2IV(r)); \ + } STMT_END #define PM_GETRE_SAFE(o) (PL_regex_pad ? PM_GETRE(o) : (REGEXP*)0) #define PM_SETRE_SAFE(o,r) if (PL_regex_pad) PM_SETRE(o,r) #else @@ -78,7 +78,7 @@ PP(pp_padav) if (SvMAGICAL(TARG)) { U32 i; for (i=0; i < (U32)maxarg; i++) { - SV ** const svp = av_fetch((AV*)TARG, i, FALSE); + SV * const * const svp = av_fetch((AV*)TARG, i, FALSE); SP[i+1] = (svp) ? *svp : &PL_sv_undef; } } @@ -160,13 +160,13 @@ PP(pp_rv2gv) GV *gv; if (cUNOP->op_targ) { STRLEN len; - SV *namesv = PAD_SV(cUNOP->op_targ); - const char *name = SvPV(namesv, len); + SV * const namesv = PAD_SV(cUNOP->op_targ); + const char * const name = SvPV(namesv, len); gv = (GV*)NEWSV(0,0); gv_init(gv, CopSTASH(PL_curcop), name, len, 0); } else { - const char *name = CopSTASHPV(PL_curcop); + const char * const name = CopSTASHPV(PL_curcop); gv = newGVgen(name); } if (SvTYPE(sv) < SVt_RV) @@ -364,7 +364,7 @@ PP(pp_prototype) ret = &PL_sv_undef; if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { - const char *s = SvPVX_const(TOPs); + const char * const s = SvPVX_const(TOPs); if (strnEQ(s, "CORE::", 6)) { const int code = keyword(s + 6, SvCUR(TOPs) - 6); if (code < 0) { /* Overridable. */ @@ -755,7 +755,7 @@ PP(pp_undef) case SVt_PVFM: { /* let user-undef'd sub keep its identity */ - GV* gv = CvGV((CV*)sv); + GV* const gv = CvGV((CV*)sv); cv_undef((CV*)sv); CvGV((CV*)sv) = gv; } @@ -1260,7 +1260,7 @@ PP(pp_modulo) if (!left_neg) { left = SvUVX(POPs); } else { - IV aiv = SvIVX(POPs); + const IV aiv = SvIVX(POPs); if (aiv >= 0) { left = aiv; left_neg = FALSE; /* effectively it's a UV now */ @@ -1352,7 +1352,7 @@ PP(pp_repeat) else count = uv; } else { - IV iv = SvIV(sv); + const IV iv = SvIV(sv); if (iv < 0) count = 0; else @@ -1370,12 +1370,10 @@ PP(pp_repeat) count = SvIVx(sv); if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { dMARK; - I32 items = SP - MARK; - I32 max; - static const char oom_list_extend[] = - "Out of memory during list extend"; + static const char oom_list_extend[] = "Out of memory during list extend"; + const I32 items = SP - MARK; + const I32 max = items * count; - max = items * count; MEM_WRAP_CHECK_1(max, SV*, oom_list_extend); /* Did the max computation overflow? */ if (items > 0 && max > 0 && (max < items || max < count)) @@ -1421,7 +1419,7 @@ PP(pp_repeat) SP -= items; } else { /* Note: mark already snarfed by pp_list */ - SV *tmpstr = POPs; + SV * const tmpstr = POPs; STRLEN len; bool isutf; static const char oom_string_extend[] = @@ -1604,11 +1602,11 @@ PP(pp_right_shift) { const IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IV i = TOPi; + const IV i = TOPi; SETi(i >> shift); } else { - UV u = TOPu; + const UV u = TOPu; SETu(u >> shift); } RETURN; @@ -1933,8 +1931,8 @@ PP(pp_ne) if (SvIOK(TOPs)) { SvIV_please(TOPm1s); if (SvIOK(TOPm1s)) { - bool auvok = SvUOK(TOPm1s); - bool buvok = SvUOK(TOPs); + const bool auvok = SvUOK(TOPm1s); + const bool buvok = SvUOK(TOPs); if (auvok == buvok) { /* ## IV == IV or UV == UV ## */ /* Casting IV to UV before comparison isn't going to matter @@ -1992,8 +1990,8 @@ PP(pp_ncmp) dSP; dTARGET; tryAMAGICbin(ncmp,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { - UV right = PTR2UV(SvRV(POPs)); - UV left = PTR2UV(SvRV(TOPs)); + const UV right = PTR2UV(SvRV(POPs)); + const UV left = PTR2UV(SvRV(TOPs)); SETi((left > right) - (left < right)); RETURN; } @@ -2680,11 +2678,7 @@ PP(pp_rand) PP(pp_srand) { dSP; - UV anum; - if (MAXARG < 1) - anum = seed(); - else - anum = POPu; + const UV anum = (MAXARG < 1) ? seed() : POPu; (void)seedDrand01((Rand_seed_t)anum); PL_srand_called = TRUE; EXTEND(SP, 1); @@ -2883,7 +2877,7 @@ PP(pp_oct) PP(pp_length) { dSP; dTARGET; - SV *sv = TOPs; + SV * const sv = TOPs; if (DO_UTF8(sv)) SETi(sv_len_utf8(sv)); @@ -3463,7 +3457,7 @@ PP(pp_uc) if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) { /* If the eventually required minimum size outgrows * the available space, we need to grow. */ - UV o = d - (U8*)SvPVX_const(TARG); + const UV o = d - (U8*)SvPVX_const(TARG); /* If someone uppercases one million U+03B0s we * SvGROW() one million times. Or we could try @@ -3566,7 +3560,7 @@ PP(pp_lc) if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) { /* If the eventually required minimum size outgrows * the available space, we need to grow. */ - UV o = d - (U8*)SvPVX_const(TARG); + const UV o = d - (U8*)SvPVX_const(TARG); /* If someone lowercases one million U+0130s we * SvGROW() one million times. Or we could try @@ -3811,7 +3805,7 @@ PP(pp_exists) if (PL_op->op_private & OPpEXISTS_SUB) { GV *gv; - SV *sv = POPs; + SV * const sv = POPs; CV * const cv = sv_2cv(sv, &hv, &gv, FALSE); if (cv) RETPUSHYES; @@ -38,8 +38,6 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) -static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen); - PP(pp_wantarray) { dSP; @@ -1561,7 +1559,7 @@ PP(pp_caller) if (!MAXARG) RETURN; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv); + GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv); /* So is ccstack[dbcxix]. */ if (isGV(cvgv)) { SV * const sv = NEWSV(49, 0); @@ -1611,9 +1609,8 @@ PP(pp_caller) const int off = AvARRAY(ary) - AvALLOC(ary); if (!PL_dbargs) { - GV* tmpgv; - PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE, - SVt_PVAV))); + GV* const tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV); + PL_dbargs = GvAV(gv_AVadd(tmpgv)); GvMULTI_on(tmpgv); AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */ } @@ -1630,7 +1627,7 @@ PP(pp_caller) HINT_PRIVATE_MASK))); { SV * mask ; - SV * old_warnings = cx->blk_oldcop->cop_warnings ; + SV * const old_warnings = cx->blk_oldcop->cop_warnings ; if (old_warnings == pWARN_NONE || (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0)) @@ -1640,7 +1637,7 @@ PP(pp_caller) /* Get the bit mask for $warnings::Bits{all}, because * it could have been extended by warnings::register */ SV **bits_all; - HV *bits = get_hv("warnings::Bits", FALSE); + HV * const bits = get_hv("warnings::Bits", FALSE); if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) { mask = newSVsv(*bits_all); } @@ -1658,12 +1655,7 @@ PP(pp_caller) PP(pp_reset) { dSP; - const char *tmps; - - if (MAXARG < 1) - tmps = ""; - else - tmps = POPpconstx; + const char * const tmps = (MAXARG < 1) ? "" : POPpconstx; sv_reset(tmps, CopSTASH(PL_curcop)); PUSHs(&PL_sv_yes); RETURN; @@ -1683,14 +1675,12 @@ PP(pp_dbstate) || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { dSP; - register CV *cv; register PERL_CONTEXT *cx; const I32 gimme = G_ARRAY; U8 hasargs; - GV *gv; + GV * const gv = PL_DBgv; + register CV * const cv = GvCV(gv); - gv = PL_DBgv; - cv = GvCV(gv); if (!cv) DIE(aTHX_ "No DB::DB routine defined"); @@ -1760,7 +1750,7 @@ PP(pp_enteriter) #endif } else { - GV *gv = (GV*)POPs; + GV * const gv = (GV*)POPs; svp = &GvSV(gv); /* symbol table variable */ SAVEGENERICSV(*svp); *svp = NEWSV(0,0); @@ -1781,7 +1771,7 @@ PP(pp_enteriter) cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { dPOPss; - SV *right = (SV*)cx->blk_loop.iterary; + SV * const right = (SV*)cx->blk_loop.iterary; SvGETMAGIC(sv); SvGETMAGIC(right); if (RANGE_IS_NUMERIC(sv,right)) { @@ -1882,7 +1872,6 @@ PP(pp_leaveloop) PP(pp_return) { dVAR; dSP; dMARK; - I32 cxix; register PERL_CONTEXT *cx; bool popsub2 = FALSE; bool clear_errsv = FALSE; @@ -1893,7 +1882,8 @@ PP(pp_return) SV *sv; OP *retop; - cxix = dopoptosub(cxstack_ix); + const I32 cxix = dopoptosub(cxstack_ix); + if (cxix < 0) { if (CxMULTICALL(cxstack)) { /* In this case we must be in a * sort block, which is a CXt_NULL @@ -2536,7 +2526,7 @@ PP(pp_goto) /* push wanted frames */ if (*enterops && enterops[1]) { - OP *oldop = PL_op; + OP * const oldop = PL_op; ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1; for (; enterops[ix]; ix++) { PL_op = enterops[ix]; @@ -3070,7 +3060,7 @@ PP(pp_require) DIE(aTHX_ "Null filename used"); TAINT_PROPER("require"); if (PL_op->op_type == OP_REQUIRE) { - SV ** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); + SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); if ( svp ) { if (*svp != &PL_sv_undef) RETPUSHYES; @@ -3347,7 +3337,7 @@ PP(pp_require) PL_compiling.cop_io = Nullsv; if (filter_sub || filter_child_proc) { - SV * const datasv = filter_add(run_user_filter, Nullsv); + SV * const datasv = filter_add(S_run_user_filter, Nullsv); IoLINES(datasv) = filter_has_file; IoFMT_GV(datasv) = (GV *)filter_child_proc; IoTOP_GV(datasv) = (GV *)filter_state; @@ -3842,14 +3832,14 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize) } static I32 -run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) +S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) { dVAR; - SV *datasv = FILTER_DATA(idx); + SV * const datasv = FILTER_DATA(idx); const int filter_has_file = IoLINES(datasv); - GV *filter_child_proc = (GV *)IoFMT_GV(datasv); - SV *filter_state = (SV *)IoTOP_GV(datasv); - SV *filter_sub = (SV *)IoBOTTOM_GV(datasv); + GV * const filter_child_proc = (GV *)IoFMT_GV(datasv); + SV * const filter_state = (SV *)IoTOP_GV(datasv); + SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv); int len = 0; /* I was having segfault trouble under Linux 2.2.5 after a @@ -3906,7 +3896,7 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) SvREFCNT_dec(filter_sub); IoBOTTOM_GV(datasv) = Nullgv; } - filter_del(run_user_filter); + filter_del(S_run_user_filter); } return len; @@ -3919,11 +3909,12 @@ S_path_is_absolute(pTHX_ const char *name) { if (PERL_FILE_IS_ABSOLUTE(name) #ifdef MACOS_TRADITIONAL - || (*name == ':')) + || (*name == ':') #else || (*name == '.' && (name[1] == '/' || - (name[1] == '.' && name[2] == '/')))) + (name[1] == '.' && name[2] == '/'))) #endif + ) { return TRUE; } @@ -111,8 +111,8 @@ PP(pp_sassign) dSP; dPOPTOPssrl; if (PL_op->op_private & OPpASSIGN_BACKWARDS) { - SV *temp; - temp = left; left = right; right = temp; + SV * const temp = left; + left = right; right = temp; } if (PL_tainting && PL_tainted && !SvTAINTED(left)) TAINT_NOT; @@ -259,8 +259,8 @@ PP(pp_eq) right argument if we know the left is integer. */ SvIV_please(TOPm1s); if (SvIOK(TOPm1s)) { - bool auvok = SvUOK(TOPm1s); - bool buvok = SvUOK(TOPs); + const bool auvok = SvUOK(TOPm1s); + const bool buvok = SvUOK(TOPs); if (auvok == buvok) { /* ## IV == IV or UV == UV ## */ /* Casting IV to UV before comparison isn't going to matter @@ -269,8 +269,8 @@ PP(pp_eq) differ from normal zero. As I understand it. (Need to check - is negative zero implementation defined behaviour anyway?). NWC */ - UV buv = SvUVX(POPs); - UV auv = SvUVX(TOPs); + const UV buv = SvUVX(POPs); + const UV auv = SvUVX(TOPs); SETs(boolSV(auv == buv)); RETURN; @@ -558,7 +558,7 @@ PP(pp_aelemfast) AV *av = PL_op->op_flags & OPf_SPECIAL ? (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); const U32 lval = PL_op->op_flags & OPf_MOD; - SV** svp = av_fetch(av, PL_op->op_private, lval); + SV** const svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); EXTEND(SP, 1); if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ @@ -601,15 +601,10 @@ PP(pp_pushre) PP(pp_print) { dVAR; dSP; dMARK; dORIGMARK; - GV *gv; IO *io; register PerlIO *fp; MAGIC *mg; - - if (PL_op->op_flags & OPf_STACKED) - gv = (GV*)*++MARK; - else - gv = PL_defoutgv; + GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv; if (gv && (io = GvIO(gv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) @@ -735,7 +735,7 @@ STMT_START { \ STRLEN glen = (in_len); \ if (utf8) glen *= UTF8_EXPAND; \ if ((cur) + glen >= (start) + SvLEN(cat)) { \ - (start) = sv_exp_grow(aTHX_ cat, glen); \ + (start) = sv_exp_grow(cat, glen); \ (cur) = (start) + SvCUR(cat); \ } \ } STMT_END @@ -748,7 +748,7 @@ STMT_START { \ if ((cur) + gl >= (start) + SvLEN(cat)) { \ *cur = '\0'; \ SvCUR_set((cat), (cur) - (start)); \ - (start) = sv_exp_grow(aTHX_ cat, gl); \ + (start) = sv_exp_grow(cat, gl); \ (cur) = (start) + SvCUR(cat); \ } \ PUSH_BYTES(utf8, cur, buf, glen); \ @@ -2502,7 +2502,7 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) { Only grows the string if there is an actual lack of space */ STATIC char * -sv_exp_grow(pTHX_ SV *sv, STRLEN needed) { +S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) { const STRLEN cur = SvCUR(sv); const STRLEN len = SvLEN(sv); STRLEN extend; @@ -1511,7 +1511,7 @@ PP(pp_sort) else { cv = sv_2cv(*++MARK, &stash, &gv, 0); if (cv && SvPOK(cv)) { - const char *proto = SvPV_nolen_const((SV*)cv); + const char * const proto = SvPV_nolen_const((SV*)cv); if (proto && strEQ(proto, "$$")) { hasargs = TRUE; } @@ -877,9 +877,9 @@ PP(pp_untie) if ((mg = SvTIED_mg(sv, how))) { SV * const obj = SvRV(SvTIED_obj(sv, mg)); - CV *cv = NULL; if (obj) { GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE); + CV *cv; if (gv && isGV(gv) && (cv = GvCV(gv))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); @@ -3178,6 +3178,9 @@ STATIC void S_call_body(pTHX_ const OP *myop, bool is_eval) STATIC void* S_call_list_body(pTHX_ CV *cv) __attribute__nonnull__(pTHX_1); +STATIC SV * S_incpush_if_exists(pTHX_ SV *dir) + __attribute__nonnull__(pTHX_1); + #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -3234,6 +3237,10 @@ STATIC char S_first_symbol(const char *pat, const char *patend) __attribute__nonnull__(1) __attribute__nonnull__(2); +STATIC char * S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); + #endif #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) @@ -3287,6 +3294,10 @@ STATIC bool S_path_is_absolute(pTHX_ const char *name) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); +STATIC I32 S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_2); + #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) @@ -3556,6 +3567,8 @@ STATIC CV* S_deb_curcv(pTHX_ I32 ix); STATIC void S_debprof(pTHX_ const OP *o) __attribute__nonnull__(pTHX_1); +STATIC void S_sequence(pTHX_ const OP *o); +STATIC UV S_sequence_num(pTHX_ const OP *o); #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -3749,7 +3762,7 @@ STATIC HV * S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); -STATIC char * S_tokenize_use(pTHX_ int, char*) +STATIC char * S_tokenize_use(pTHX_ int is_use, char*) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2); @@ -3765,6 +3778,9 @@ STATIC void S_depcom(pTHX); STATIC const char* S_incl_perldb(pTHX); # if defined(PERL_CR_FILTER) STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen); +STATIC void S_strip_return(pTHX_ SV *sv) + __attribute__nonnull__(pTHX_1); + # endif #endif @@ -3789,6 +3805,9 @@ STATIC COP* S_closest_cop(pTHX_ COP *cop, const OP *o) STATIC SV* S_mess_alloc(pTHX); STATIC const char * S_vdie_croak_common(pTHX_ const char *pat, va_list *args, STRLEN *msglen, I32* utf8); STATIC void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8); +STATIC char * S_write_no_mem(pTHX) + __attribute__noreturn__; + #endif #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) @@ -5822,8 +5822,9 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) else if (k == ANYOF) { int i, rangestart = -1; const U8 flags = ANYOF_FLAGS(o); - const char * const anyofs[] = { /* Should be synchronized with - * ANYOF_ #xdefines in regcomp.h */ + + /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */ + static const char * const anyofs[] = { "\\w", "\\W", "\\s", @@ -357,7 +357,7 @@ and split it into a list of free SVs. void Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) { - SV* sva = (SV*)ptr; + SV* const sva = (SV*)ptr; register SV* sv; register SV* svend; @@ -161,7 +161,7 @@ Perl_taint_env(pTHX) #endif /* !VMS */ for (e = misc_env; *e; e++) { - SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); + SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { TAINT; taint_proper("Insecure $ENV{%s}%s", *e); @@ -26,12 +26,7 @@ #define yychar (*PL_yycharp) #define yylval (*PL_yylvalp) -static const char ident_too_long[] = - "Identifier too long"; -static const char c_without_g[] = - "Use of /c modifier is meaningless without /g"; -static const char c_in_subst[] = - "Use of /c modifier is meaningless in s///"; +static const char ident_too_long[] = "Identifier too long"; static void restore_rsfp(pTHX_ void *f); #ifndef PERL_NO_UTF16_FILTER @@ -2651,10 +2646,9 @@ Perl_yylex(pTHX) PL_last_uni = 0; PL_last_lop = 0; if (PL_lex_brackets) { - if (PL_lex_formbrack) - yyerror("Format not terminated"); - else - yyerror("Missing right curly or square bracket"); + yyerror(PL_lex_formbrack + ? "Format not terminated" + : "Missing right curly or square bracket"); } DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Tokener got EOF\n"); @@ -3319,11 +3313,9 @@ Perl_yylex(pTHX) context messages from yyerror(). */ PL_bufptr = s; - if (!*s) - yyerror("Unterminated attribute list"); - else - yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", - q, *s, q)); + yyerror( *s + ? Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", q, *s, q) + : "Unterminated attribute list" ); if (attrs) op_free(attrs); OPERATOR(':'); @@ -9367,7 +9359,7 @@ S_scan_pat(pTHX_ char *start, I32 type) if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL) && ckWARN(WARN_REGEXP)) { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g); + Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" ); } pm->op_pmpermflags = pm->op_pmflags; @@ -9419,10 +9411,8 @@ S_scan_subst(pTHX_ char *start) break; } - /* /c is not meaningful with s/// */ - if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) - { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst); + if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) { + Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); } if (es) { @@ -10932,7 +10922,7 @@ S_swallow_bom(pTHX_ U8 *s) static void restore_rsfp(pTHX_ void *f) { - PerlIO *fp = (PerlIO*)f; + PerlIO * const fp = (PerlIO*)f; if (PL_rsfp == PerlIO_stdin()) PerlIO_clearerr(PL_rsfp); @@ -11020,16 +11010,15 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv) } if (!isALPHA(*pos)) { - UV rev; U8 tmpbuf[UTF8_MAXBYTES+1]; - U8 *tmpend; if (*s == 'v') s++; /* get past 'v' */ sv_setpvn(sv, "", 0); for (;;) { - rev = 0; + U8 *tmpend; + UV rev = 0; { /* this is atoi() that tolerates underscores */ const char *end = pos; @@ -1759,17 +1759,17 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span) STRLEN lcur, xcur, scur; HV* const hv = (HV*)SvRV(swash); - SV** listsvp = hv_fetch(hv, "LIST", 4, FALSE); - SV** typesvp = hv_fetch(hv, "TYPE", 4, FALSE); - SV** bitssvp = hv_fetch(hv, "BITS", 4, FALSE); - SV** nonesvp = hv_fetch(hv, "NONE", 4, FALSE); - SV** extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE); - U8* typestr = (U8*)SvPV_nolen(*typesvp); - int typeto = typestr[0] == 'T' && typestr[1] == 'o'; - STRLEN bits = SvUV(*bitssvp); - STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */ - UV none = SvUV(*nonesvp); - UV end = start + span; + SV** const listsvp = hv_fetch(hv, "LIST", 4, FALSE); + SV** const typesvp = hv_fetch(hv, "TYPE", 4, FALSE); + SV** const bitssvp = hv_fetch(hv, "BITS", 4, FALSE); + SV** const nonesvp = hv_fetch(hv, "NONE", 4, FALSE); + SV** const extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE); + const U8* const typestr = (U8*)SvPV_nolen(*typesvp); + const int typeto = typestr[0] == 'T' && typestr[1] == 'o'; + const STRLEN bits = SvUV(*bitssvp); + const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */ + const UV none = SvUV(*nonesvp); + const UV end = start + span; if (bits != 1 && bits != 8 && bits != 16 && bits != 32) { Perl_croak(aTHX_ "panic: swash_get doesn't expect bits %"UVuf, @@ -1782,7 +1782,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span) SvGROW(swatch, scur + 1); s = (U8*)SvPVX(swatch); if (octets && none) { - const U8* e = s + scur; + const U8* const e = s + scur; while (s < e) { if (bits == 8) *s++ = (U8)(none & 0xff); @@ -1813,7 +1813,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span) STRLEN numlen; I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX; - U8* nl = (U8*)memchr(l, '\n', lend - l); + U8* const nl = (U8*)memchr(l, '\n', lend - l); numlen = lend - l; min = grok_hex((char *)l, &numlen, &flags, NULL); @@ -1915,7 +1915,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span) if (min < start) min = start; for (key = min; key <= max; key++) { - STRLEN offset = (STRLEN)(key - start); + const STRLEN offset = (STRLEN)(key - start); if (key >= end) goto go_out_list; s[offset >> 3] |= 1 << (offset & 7); @@ -2151,7 +2151,7 @@ Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV f u = utf8_to_uvchr((U8*)s, 0); if (u < 256) { const unsigned char c = (unsigned char)u & 0xFF; - if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) { + if (flags & UNI_DISPLAY_BACKSLASH) { switch (c) { case '\n': ok = 'n'; break; @@ -64,7 +64,7 @@ S_write_no_mem(pTHX) PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem)); my_exit(1); - return Nullch; + NORETURN_FUNCTION_END } /* paranoid version of system's malloc() */ @@ -101,7 +101,7 @@ Perl_safesysmalloc(MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - return S_write_no_mem(aTHX); + return write_no_mem(); } /*NOTREACHED*/ } @@ -158,7 +158,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - return S_write_no_mem(aTHX); + return write_no_mem(); } /*NOTREACHED*/ } @@ -221,10 +221,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) } else if (PL_nomemok) return Nullch; - else { - return S_write_no_mem(aTHX); - } - /*NOTREACHED*/ + return write_no_mem(); } /* These must be defined when not using Perl's malloc for binary @@ -851,7 +848,7 @@ Perl_savesharedpv(pTHX_ const char *pv) pvlen = strlen(pv)+1; newaddr = (char*)PerlMemShared_malloc(pvlen); if (!newaddr) { - return S_write_no_mem(aTHX); + return write_no_mem(); } return memcpy(newaddr,pv,pvlen); } |