diff options
| author | Andy Lester <andy@petdance.com> | 2005-05-16 05:13:53 -0500 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-05-16 16:56:43 +0000 |
| commit | a3b680e6b77dd7f88268fad8b1dbdf4f641dd836 (patch) | |
| tree | 5b6dc5a60baf7a56b2db73bf0faffe0c3c44963c | |
| parent | 02a44301bf4932369de0c75ad20a9c1256a455cd (diff) | |
| download | perl-a3b680e6b77dd7f88268fad8b1dbdf4f641dd836.tar.gz | |
consting-eleventy.patch: More consts, plus actual bug fix
Message-ID: <20050516151353.GA25387@petdance.com>
p4raw-id: //depot/perl@24489
| -rw-r--r-- | XSUB.h | 8 | ||||
| -rw-r--r-- | av.c | 8 | ||||
| -rw-r--r-- | dump.c | 10 | ||||
| -rw-r--r-- | embed.fnc | 149 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | hv.c | 48 | ||||
| -rw-r--r-- | malloc.c | 8 | ||||
| -rw-r--r-- | mg.c | 10 | ||||
| -rw-r--r-- | numeric.c | 3 | ||||
| -rw-r--r-- | perl.c | 8 | ||||
| -rw-r--r-- | perl.h | 8 | ||||
| -rw-r--r-- | pod/perlapi.pod | 6 | ||||
| -rw-r--r-- | pp.h | 3 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | pp_hot.c | 79 | ||||
| -rw-r--r-- | proto.h | 248 | ||||
| -rw-r--r-- | regcomp.c | 12 | ||||
| -rw-r--r-- | regexec.c | 71 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 70 | ||||
| -rw-r--r-- | sv.h | 4 | ||||
| -rw-r--r-- | t/run/fresh_perl.t | 2 | ||||
| -rw-r--r-- | toke.c | 2 | ||||
| -rw-r--r-- | universal.c | 22 | ||||
| -rw-r--r-- | utf8.c | 34 | ||||
| -rw-r--r-- | util.c | 6 |
26 files changed, 473 insertions, 352 deletions
@@ -99,18 +99,18 @@ is a lexical $_ in scope. # endif #endif -#define dAX I32 ax = MARK - PL_stack_base + 1 +#define dAX const I32 ax = MARK - PL_stack_base + 1 #define dAXMARK \ - I32 ax = POPMARK; \ - register SV **mark = PL_stack_base + ax++ + I32 ax = POPMARK; \ + register SV ** const mark = PL_stack_base + ax++ #define dITEMS I32 items = SP - MARK #define dXSARGS \ dSP; dAXMARK; dITEMS -#define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ +#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ ? PAD_SV(PL_op->op_targ) : sv_newmortal()) /* Should be used before final PUSHi etc. if not in PPCODE section. */ @@ -487,8 +487,6 @@ Undefines the array. Frees the memory used by the array itself. void Perl_av_undef(pTHX_ register AV *av) { - register I32 key; - if (!av) return; /*SUPPRESS 560*/ @@ -498,7 +496,7 @@ Perl_av_undef(pTHX_ register AV *av) av_fill(av, -1); /* mg_clear() ? */ if (AvREAL(av)) { - key = AvFILLp(av) + 1; + register I32 key = AvFILLp(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } @@ -608,9 +606,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) { dVAR; register I32 i; - register SV **ary; MAGIC* mg; - I32 slide; if (!av) return; @@ -649,6 +645,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) SvPV_set(av, (char*)(AvARRAY(av) - i)); } if (num) { + register SV **ary; + I32 slide; i = AvFILLp(av); /* Create extra elements */ slide = i > 0 ? i : 0; @@ -1592,9 +1592,6 @@ Perl_runops_debug(pTHX) I32 Perl_debop(pTHX_ const OP *o) { - CV *cv; - SV *sv; - if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) return 0; @@ -1606,7 +1603,7 @@ Perl_debop(pTHX_ const OP *o) case OP_GVSV: case OP_GV: if (cGVOPo_gv) { - sv = NEWSV(0,0); + SV *sv = NEWSV(0,0); gv_fullname3(sv, cGVOPo_gv, Nullch); PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv)); SvREFCNT_dec(sv); @@ -1617,8 +1614,10 @@ Perl_debop(pTHX_ const OP *o) case OP_PADSV: case OP_PADAV: case OP_PADHV: + { /* print the lexical's name */ - cv = deb_curcv(cxstack_ix); + CV *cv = deb_curcv(cxstack_ix); + SV *sv; if (cv) { AV *padlist = CvPADLIST(cv); AV *comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); @@ -1629,6 +1628,7 @@ Perl_debop(pTHX_ const OP *o) PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv)); else PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ); + } break; default: break; @@ -91,29 +91,29 @@ p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp ApM |void |apply_attrs_string|const char *stashpv|CV *cv|const char *attrstr|STRLEN len Apd |void |av_clear |AV* ar -Apd |SV* |av_delete |AV* ar|I32 key|I32 flags -Apd |bool |av_exists |AV* ar|I32 key -Apd |void |av_extend |AV* ar|I32 key -p |AV* |av_fake |I32 size|SV** svp -Apd |SV** |av_fetch |AV* ar|I32 key|I32 lval +ApdR |SV* |av_delete |AV* ar|I32 key|I32 flags +ApdR |bool |av_exists |AV* ar|I32 key +Apd |void |av_extend |NN AV* ar|I32 key +pR |AV* |av_fake |I32 size|NN SV** svp +ApdR |SV** |av_fetch |AV* ar|I32 key|I32 lval Apd |void |av_fill |AV* ar|I32 fill -Apd |I32 |av_len |const AV* ar -Apd |AV* |av_make |I32 size|SV** svp -Apd |SV* |av_pop |AV* ar +ApdR |I32 |av_len |const AV* ar +ApdR |AV* |av_make |I32 size|NN SV** svp +ApdR |SV* |av_pop |AV* ar Apd |void |av_push |AV* ar|SV* val p |void |av_reify |AV* ar -Apd |SV* |av_shift |AV* ar +ApdR |SV* |av_shift |AV* ar Apd |SV** |av_store |AV* ar|I32 key|SV* val Apd |void |av_undef |AV* ar Apd |void |av_unshift |AV* ar|I32 num -p |OP* |bind_match |I32 type|OP* left|OP* pat -p |OP* |block_end |I32 floor|OP* seq -Ap |I32 |block_gimme -p |int |block_start |int full +pR |OP* |bind_match |I32 type|NN OP* left|NN OP* pat +pR |OP* |block_end |I32 floor|OP* seq +ApR |I32 |block_gimme +pR |int |block_start |int full p |void |boot_core_UNIVERSAL p |void |boot_core_PerlIO -Ap |void |call_list |I32 oldscope|AV* av_list -p |bool |cando |Mode_t mode|Uid_t effective|NN const Stat_t* statbufp +Ap |void |call_list |I32 oldscope|NN AV* av_list +pR |bool |cando |Mode_t mode|Uid_t effective|NN const Stat_t* statbufp Ap |U32 |cast_ulong |NV f Ap |I32 |cast_i32 |NV f Ap |IV |cast_iv |NV f @@ -141,7 +141,7 @@ Afnp |void |sv_setpvf_mg_nocontext|SV* sv|const char* pat|... Afnp |int |fprintf_nocontext|PerlIO* stream|const char* fmt|... Afnp |int |printf_nocontext|const char* fmt|... #endif -p |void |cv_ckproto |const CV* cv|const GV* gv|const char* p +p |void |cv_ckproto |NN const CV* cv|const GV* gv|const char* p pd |CV* |cv_clone |NN CV* proto Apd |SV* |cv_const_sv |CV* cv p |SV* |op_const_sv |const OP* o|CV* cv @@ -150,12 +150,12 @@ Ap |void |cx_dump |PERL_CONTEXT* cs Ap |SV* |filter_add |filter_t funcp|SV* datasv Ap |void |filter_del |filter_t funcp Ap |I32 |filter_read |int idx|SV* buffer|int maxlen -ApP |char** |get_op_descs -ApP |char** |get_op_names -pP |const char* |get_no_modify -pP |U32* |get_opargs -ApP |PPADDR_t*|get_ppaddr -Ep |I32 |cxinc +ApPR |char** |get_op_descs +ApPR |char** |get_op_names +pPR |const char* |get_no_modify +pPR |U32* |get_opargs +ApPR |PPADDR_t*|get_ppaddr +EpR |I32 |cxinc Afp |void |deb |const char* pat|... Ap |void |vdeb |const char* pat|va_list* args Ap |void |debprofdump @@ -279,15 +279,15 @@ Apd |bool |hv_exists |HV* tb|const char* key|I32 klen Apd |bool |hv_exists_ent |HV* tb|SV* key|U32 hash Apd |SV** |hv_fetch |HV* tb|const char* key|I32 klen|I32 lval Apd |HE* |hv_fetch_ent |HV* tb|SV* key|I32 lval|U32 hash -Ap |void |hv_free_ent |HV* hv|HE* entry -Apd |I32 |hv_iterinit |HV* tb -Apd |char* |hv_iterkey |HE* entry|I32* retlen -Apd |SV* |hv_iterkeysv |HE* entry -Apd |HE* |hv_iternext |HV* tb -Apd |SV* |hv_iternextsv |HV* hv|char** key|I32* retlen -ApMd |HE* |hv_iternext_flags|HV* tb|I32 flags -Apd |SV* |hv_iterval |HV* tb|HE* entry -Ap |void |hv_ksplit |HV* hv|IV newmax +Ap |void |hv_free_ent |NN HV* hv|HE* entry +Apd |I32 |hv_iterinit |NN HV* tb +ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen +ApdR |SV* |hv_iterkeysv |NN HE* entry +ApdR |HE* |hv_iternext |NN HV* tb +ApdR |SV* |hv_iternextsv |NN HV* hv|NN char** key|NN I32* retlen +ApMdR |HE* |hv_iternext_flags|NN HV* tb|I32 flags +ApdR |SV* |hv_iterval |NN HV* tb|NN HE* entry +Ap |void |hv_ksplit |NN HV* hv|IV newmax Apd |void |hv_magic |HV* hv|GV* gv|int how Apd |SV** |hv_store |HV* tb|const char* key|I32 klen|SV* val \ |U32 hash @@ -379,11 +379,11 @@ Apd |void |load_module|U32 flags|SV* name|SV* ver|... Ap |void |vload_module|U32 flags|SV* name|SV* ver|va_list* args p |OP* |localize |OP* arg|I32 lexical ApdR |I32 |looks_like_number|NN SV* sv -Apd |UV |grok_bin |NN const char* start|NN STRLEN* len|NN I32* flags|NV *result -Apd |UV |grok_hex |NN const char* start|NN STRLEN* len|NN I32* flags|NV *result +Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NV *result +Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NV *result Apd |int |grok_number |NN const char *pv|STRLEN len|UV *valuep Apd |bool |grok_numeric_radix|const char **sp|const char *send -Apd |UV |grok_oct |const char* start|STRLEN* len|I32* flags|NV *result +Apd |UV |grok_oct |const char* start|STRLEN* len_p|I32* flags|NV *result p |int |magic_clearenv |SV* sv|MAGIC* mg p |int |magic_clear_all_env|SV* sv|MAGIC* mg p |int |magic_clearpack|SV* sv|MAGIC* mg @@ -517,9 +517,9 @@ Apa |OP* |newCVREF |I32 flags|OP* o Apa |OP* |newGVOP |I32 type|I32 flags|GV* gv Apa |GV* |newGVgen |const char* pack Apa |OP* |newGVREF |I32 type|OP* o -Apa |OP* |newHVREF |NN OP* o -Apda |HV* |newHV -Apa |HV* |newHVhv |HV* hv +ApaR |OP* |newHVREF |NN OP* o +ApdaR |HV* |newHV +ApaR |HV* |newHVhv |HV* hv Apa |IO* |newIO Apa |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last Apa |OP* |newPADOP |I32 type|I32 flags|SV* sv @@ -611,7 +611,7 @@ Ap |void |push_scope p |OP* |ref |OP* o|I32 type p |OP* |refkids |OP* o|I32 type Ap |void |regdump |NN regexp* r -Ap |SV* |regclass_swash |struct regnode *n|bool doinit|SV **listsvp|SV **altsvp +Ap |SV* |regclass_swash |const struct regnode *n|bool doinit|SV **listsvp|SV **altsvp Ap |I32 |pregexec |NN regexp* prog|NN char* stringarg \ |NN char* strend|NN char* strbeg|I32 minend \ |NN SV* screamer|U32 nosave @@ -621,21 +621,21 @@ Ap |char* |re_intuit_start|regexp* prog|SV* sv|char* strpos \ |char* strend|U32 flags \ |struct re_scream_pos_data_s *data Ap |SV* |re_intuit_string|regexp* prog -Ap |I32 |regexec_flags |regexp* prog|char* stringarg \ - |char* strend|char* strbeg|I32 minend \ +Ap |I32 |regexec_flags |NN regexp* prog|NN char* stringarg \ + |NN char* strend|NN char* strbeg|I32 minend \ |SV* screamer|void* data|U32 flags Ap |regnode*|regnext |regnode* p -Ep |void |regprop |SV* sv|regnode* o +Ep |void |regprop |SV* sv|const regnode* o Ap |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count -ApP |char* |rninstr |const char* big|const char* bigend \ - |const char* little|const char* lend +ApP |char* |rninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend Ap |Sighandler_t|rsignal |int i|Sighandler_t t p |int |rsignal_restore|int i|Sigsave_t* t p |int |rsignal_save |int i|Sighandler_t t1|Sigsave_t* t2 Ap |Sighandler_t|rsignal_state|int i -p |void |rxres_free |void** rsp -p |void |rxres_restore |void** rsp|REGEXP* prx -p |void |rxres_save |void** rsp|REGEXP* prx +p |void |rxres_free |NN void** rsp +p |void |rxres_restore |NN void** rsp|NN REGEXP* prx +p |void |rxres_save |NN void** rsp|NN REGEXP* prx #if !defined(HAS_RENAME) p |I32 |same_dirent |NN const char* a|NN const char* b #endif @@ -703,7 +703,7 @@ p |HEK* |share_hek |const char* sv|I32 len|U32 hash np |Signal_t |sighandler |int sig Anp |Signal_t |csighandler |int sig Ap |SV** |stack_grow |NN SV** sp|NN SV**p|int n -Ap |I32 |start_subparse |I32 is_format|U32 flags +ApR |I32 |start_subparse |I32 is_format|U32 flags p |void |sub_crush_depth|CV* cv Apd |bool |sv_2bool |NN SV* sv Apd |CV* |sv_2cv |NN SV* sv|HV** st|GV** gvp|I32 lref @@ -747,7 +747,7 @@ Ap |OP* |sv_compile_2op |NN SV* sv|NN OP** startp|NN const char* code|NN PAD** p Apd |int |getcwd_sv |NN SV* sv Apd |void |sv_dec |NN SV* sv Ap |void |sv_dump |NN SV* sv -Apd |bool |sv_derived_from|NN SV* sv|NN const char* name +ApdR |bool |sv_derived_from|NN SV* sv|NN const char* name Apd |I32 |sv_eq |NN SV* sv1|NN SV* sv2 Apd |void |sv_free |SV* sv poMX |void |sv_free2 |NN SV* sv @@ -777,8 +777,8 @@ Apd |char* |sv_pvbyten_force|SV* sv|STRLEN* lp Apd |char* |sv_recode_to_utf8 |SV* sv|SV *encoding Apd |bool |sv_cat_decode |SV* dsv|SV *encoding|SV *ssv|int *offset \ |char* tstr|int tlen -Apd |char* |sv_reftype |const SV* sv|int ob -Apd |void |sv_replace |SV* sv|SV* nsv +ApdR |char* |sv_reftype |NN const SV* sv|int ob +Apd |void |sv_replace |NN SV* sv|NN SV* nsv Apd |void |sv_report_used Apd |void |sv_reset |const char* s|HV* stash Afpd |void |sv_setpvf |SV* sv|const char* pat|... @@ -830,9 +830,9 @@ p |void |unshare_hek |HEK* hek p |void |utilize |int aver|I32 floor|OP* version|OP* idop|OP* arg Ap |U8* |utf16_to_utf8 |U8* p|U8 *d|I32 bytelen|I32 *newlen Ap |U8* |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen -AdpP |STRLEN |utf8_length |NN const U8* s|NN const U8 *e -ApdP |IV |utf8_distance |NN const U8 *a|NN const U8 *b -ApdP |U8* |utf8_hop |NN const U8 *s|I32 off +AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e +ApdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b +ApdPR |U8* |utf8_hop |NN const U8 *s|I32 off ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len ApMd |U8* |bytes_from_utf8|const U8 *s|STRLEN *len|bool *is_utf8 ApMd |U8* |bytes_to_utf8 |const U8 *s|STRLEN *len @@ -846,7 +846,7 @@ Ap |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |char* |pv_uni_display |SV *dsv|const U8 *spv|STRLEN len \ |STRLEN pvlim|UV flags -Apd |char* |sv_uni_display |SV *dsv|SV *ssv|STRLEN pvlim|UV flags +ApdR |char* |sv_uni_display |SV *dsv|SV *ssv|STRLEN pvlim|UV flags p |void |vivify_defelem |SV* sv p |void |vivify_ref |SV* sv|U32 to_what p |I32 |wait4pid |Pid_t pid|int* statusp|int flags @@ -987,7 +987,7 @@ s |I32 |do_trans_complex_utf8 |NN SV *sv #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) s |void |gv_init_sv |GV *gv|I32 sv_type -s |void |require_errno |GV *gv +s |void |require_errno |NN GV *gv #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) @@ -1114,7 +1114,7 @@ Es |regnode*|regatom |struct RExC_state_t*|I32 * Es |regnode*|regbranch |struct RExC_state_t*|I32 *|I32 Es |void |reguni |struct RExC_state_t*|UV|char *|STRLEN* Es |regnode*|regclass |struct RExC_state_t* -Es |I32 |regcurly |char * +ERs |I32 |regcurly |NN const char * Es |regnode*|reg_node |struct RExC_state_t*|U8 Es |regnode*|regpiece |struct RExC_state_t*|I32 * Es |void |reginsert |struct RExC_state_t*|U8|regnode * @@ -1150,22 +1150,22 @@ Es |I32 |make_trie |struct RExC_state_t*|regnode *startbranch \ #endif #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) -Es |I32 |regmatch |regnode *prog -Es |I32 |regrepeat |regnode *p|I32 max -Es |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp -Es |I32 |regtry |regexp *prog|char *startpos -Es |bool |reginclass |regnode *n|U8 *p|STRLEN *lenp|bool do_utf8sv_is_utf8 +ERs |I32 |regmatch |NN regnode *prog +ERs |I32 |regrepeat |NN const regnode *p|I32 max +ERs |I32 |regrepeat_hard |NN regnode *p|I32 max|NN I32 *lp +ERs |I32 |regtry |regexp *prog|char *startpos +ERs |bool |reginclass |NN const regnode *n|NN const U8 *p|STRLEN *lenp|bool do_utf8sv_is_utf8 Es |CHECKPOINT|regcppush |I32 parenfloor Es |char*|regcppop Es |char*|regcp_set_to |I32 ss Es |void |cache_re |regexp *prog -Es |U8* |reghop |U8 *pos|I32 off -Es |U8* |reghop3 |U8 *pos|I32 off|U8 *lim -Es |U8* |reghopmaybe |U8 *pos|I32 off -Es |U8* |reghopmaybe3 |U8 *pos|I32 off|U8 *lim -Es |char* |find_byclass |regexp * prog|regnode *c|char *s|char *strend|I32 norun -Es |void |to_utf8_substr |regexp * prog -Es |void |to_byte_substr |regexp * prog +ERs |U8* |reghop |U8 *pos|I32 off +ERs |U8* |reghop3 |U8 *pos|I32 off|U8 *lim +ERs |U8* |reghopmaybe |U8 *pos|I32 off +ERs |U8* |reghopmaybe3 |NN U8 *pos|I32 off|NN U8 *lim +ERs |char* |find_byclass |NN regexp * prog|NN regnode *c|NN char *s|NN const char *strend|I32 norun +Es |void |to_utf8_substr |NN regexp * prog +Es |void |to_byte_substr |NN regexp * prog #endif #if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) @@ -1211,19 +1211,24 @@ s |void |not_a_number |SV *sv s |I32 |visit |SVFUNC_t f|U32 flags|U32 mask s |void |sv_add_backref |SV *tsv|SV *sv s |void |sv_del_backref |SV *sv +s |SV * |varname |GV *gv|NN const char *gvtype|PADOFFSET targ \ + |SV *keyname|I32 aindex|int subscript_type # ifdef DEBUGGING s |void |del_sv |SV *p # endif # if !defined(NV_PRESERVES_UV) s |int |sv_2iuv_non_preserve |SV *sv|I32 numtype # endif -s |I32 |expect_number |char** pattern +sR |I32 |expect_number |NN char** pattern # # if defined(USE_ITHREADS) s |SV* |gv_share |SV *sv|CLONE_PARAMS *param # endif -s |bool |utf8_mg_pos |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|I32 uoff|U8 **sp|U8 *start|U8 *send -s |bool |utf8_mg_pos_init |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|U8 *s|U8 *start +s |bool |utf8_mg_pos |NN SV *sv|NN MAGIC **mgp|NN STRLEN **cachep \ + |I32 i|NN I32 *offsetp|I32 uoff|NN U8 **sp \ + |NN U8 *start|NN U8 *send +s |bool |utf8_mg_pos_init |NN SV *sv|NN MAGIC **mgp|NN STRLEN **cachep \ + |I32 i|I32 offsetp|NN U8 *s|NN U8 *start #if defined(PERL_COPY_ON_WRITE) sM |void |sv_release_COW |SV *sv|char *pvx|STRLEN cur|STRLEN len \ |U32 hash|SV *after @@ -1376,7 +1381,7 @@ sd |PADOFFSET|pad_findlex |const char *name|const CV* cv|U32 seq|int warn \ sd |void |cv_dump |const CV *cv|const char *title # endif #endif -pd |CV* |find_runcv |U32 *db_seqp +pdR |CV* |find_runcv |U32 *db_seqp p |void |free_tied_hv_pool #if defined(DEBUGGING) p |int |get_debug_opts |const char **s|bool givehelp @@ -1272,6 +1272,7 @@ #define visit S_visit #define sv_add_backref S_sv_add_backref #define sv_del_backref S_sv_del_backref +#define varname S_varname #endif # ifdef DEBUGGING #ifdef PERL_CORE @@ -3219,6 +3220,7 @@ #define visit(a,b,c) S_visit(aTHX_ a,b,c) #define sv_add_backref(a,b) S_sv_add_backref(aTHX_ a,b) #define sv_del_backref(a) S_sv_del_backref(aTHX_ a) +#define varname(a,b,c,d,e,f) S_varname(aTHX_ a,b,c,d,e,f) #endif # ifdef DEBUGGING #ifdef PERL_CORE @@ -527,7 +527,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); if (needs_copy) { - bool save_taint = PL_tainted; + const bool save_taint = PL_tainted; if (keysv || is_utf8) { if (!keysv) { keysv = newSVpvn(key, klen); @@ -788,7 +788,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, STATIC void S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store) { - MAGIC *mg = SvMAGIC(hv); + const MAGIC *mg = SvMAGIC(hv); *needs_copy = FALSE; *needs_store = TRUE; while (mg) { @@ -1052,13 +1052,11 @@ STATIC void S_hsplit(pTHX_ HV *hv) { register XPVHV* xhv = (XPVHV*)SvANY(hv); - I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ + const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize = oldsize * 2; register I32 i; register char *a = xhv->xhv_array; /* HvARRAY(hv) */ register HE **aep; - register HE **bep; - register HE *entry; register HE **oentry; int longest_chain = 0; int was_shared; @@ -1105,6 +1103,8 @@ S_hsplit(pTHX_ HV *hv) for (i=0; i<oldsize; i++,aep++) { int left_length = 0; int right_length = 0; + register HE *entry; + register HE **bep; if (!*aep) /* non-existent */ continue; @@ -1163,12 +1163,13 @@ S_hsplit(pTHX_ HV *hv) aep = (HE **) xhv->xhv_array; for (i=0; i<newsize; i++,aep++) { - entry = *aep; + register HE *entry = *aep; 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); UV hash; + HE **bep; /* Rehash it */ PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry)); @@ -1206,10 +1207,9 @@ void Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) { register XPVHV* xhv = (XPVHV*)SvANY(hv); - I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ + const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize; register I32 i; - register I32 j; register char *a; register HE **aep; register HE *entry; @@ -1265,6 +1265,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) if (!*aep) /* non-existent */ continue; for (oentry = aep, entry = *aep; entry; entry = *oentry) { + register I32 j; if ((j = (HeHASH(entry) & newsize)) != i) { j -= i; *oentry = HeNEXT(entry); @@ -1324,7 +1325,7 @@ Perl_newHVhv(pTHX_ HV *ohv) if (!SvMAGICAL((SV *)ohv)) { /* It's an ordinary hash, so copy it fast. AMS 20010804 */ STRLEN i; - bool shared = !!HvSHAREKEYS(ohv); + const bool shared = !!HvSHAREKEYS(ohv); HE **ents, **oents = (HE **)HvARRAY(ohv); char *a; New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char); @@ -1341,10 +1342,10 @@ Perl_newHVhv(pTHX_ HV *ohv) /* Copy the linked list of entries. */ for (oent = oents[i]; oent; oent = HeNEXT(oent)) { - U32 hash = HeHASH(oent); - char *key = HeKEY(oent); - STRLEN len = HeKLEN(oent); - int flags = HeKFLAGS(oent); + const U32 hash = HeHASH(oent); + const char * const key = HeKEY(oent); + const STRLEN len = HeKLEN(oent); + const int flags = HeKFLAGS(oent); ent = new_HE(); HeVAL(ent) = newSVsv(HeVAL(oent)); @@ -1368,8 +1369,8 @@ Perl_newHVhv(pTHX_ HV *ohv) else { /* Iterate over ohv, copying keys and values one at a time. */ HE *entry; - I32 riter = HvRITER(ohv); - HE *eiter = HvEITER(ohv); + const I32 riter = HvRITER(ohv); + HE * const eiter = HvEITER(ohv); /* Can we use fewer buckets? (hv_max is always 2^n-1) */ while (hv_max && hv_max + 1 >= hv_fill * 2) @@ -1453,9 +1454,8 @@ Perl_hv_clear(pTHX_ HV *hv) if (SvREADONLY(hv) && xhv->xhv_array != NULL) { /* restricted hash: convert all keys to placeholders */ I32 i; - HE* entry; for (i = 0; i <= (I32) xhv->xhv_max; i++) { - entry = ((HE**)xhv->xhv_array)[i]; + HE *entry = ((HE**)xhv->xhv_array)[i]; for (; entry; entry = HeNEXT(entry)) { /* not already placeholder */ if (HeVAL(entry) != &PL_sv_placeholder) { @@ -1515,7 +1515,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv) do { /* Loop down the linked list heads */ - int first = 1; + bool first = 1; HE **oentry = &(HvARRAY(hv))[i]; HE *entry = *oentry; @@ -1556,7 +1556,6 @@ S_hfreeentries(pTHX_ HV *hv) { register HE **array; register HE *entry; - register HE *oentry = Null(HE*); I32 riter; I32 max; @@ -1577,7 +1576,7 @@ S_hfreeentries(pTHX_ HV *hv) entry = array[0]; for (;;) { if (entry) { - oentry = entry; + register HE *oentry = entry; entry = HeNEXT(entry); hv_free_ent(hv, oentry); } @@ -1837,7 +1836,7 @@ Perl_hv_iterkeysv(pTHX_ register HE *entry) { if (HeKLEN(entry) != HEf_SVKEY) { HEK *hek = HeKEY_hek(entry); - int flags = HEK_FLAGS(hek); + const int flags = HEK_FLAGS(hek); SV *sv; if (flags & HVhek_WASUTF8) { @@ -1887,7 +1886,8 @@ Perl_hv_iterval(pTHX_ HV *hv, register HE *entry) SV* sv = sv_newmortal(); if (HeKLEN(entry) == HEf_SVKEY) mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); - else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); + else + mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); return sv; } } @@ -1964,7 +1964,7 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) register HE *entry; register HE **oentry; register I32 i = 1; - I32 found = 0; + bool found = 0; bool is_utf8 = FALSE; int k_flags = 0; const char *save = str; @@ -2145,7 +2145,7 @@ Perl_hv_assert(pTHX_ HV *hv) int placeholders = 0; int real = 0; int bad = 0; - I32 riter = HvRITER(hv); + const I32 riter = HvRITER(hv); HE *eiter = HvEITER(hv); (void)hv_iterinit(hv); @@ -641,7 +641,7 @@ struct aligner { #ifdef BUCKETS_ROOT2 # define MAX_BUCKET_BY_TABLE 13 -static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = +static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = { 0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80, }; @@ -805,7 +805,7 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define N_BLKS(bucket) n_blks[bucket] #endif -static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = +static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = { # if BUCKETS_PER_POW2==1 0, 0, @@ -828,7 +828,7 @@ static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = # define BLK_SHIFT(bucket) blk_shift[bucket] #endif -static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = +static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = { # if BUCKETS_PER_POW2==1 0, 0, @@ -876,7 +876,7 @@ static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = # else # define SIZE_TABLE_MAX 64 # endif -static char bucket_of[] = +static const char bucket_of[] = { # ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */ /* 0 to 15 in 4-byte increments. */ @@ -914,21 +914,21 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '(': sv_setiv(sv, (IV)PL_gid); #ifdef HAS_GETGROUPS - Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid); + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid); #endif goto add_groups; case ')': sv_setiv(sv, (IV)PL_egid); #ifdef HAS_GETGROUPS - Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid); + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid); #endif add_groups: #ifdef HAS_GETGROUPS { Groups_t gary[NGROUPS]; - i = getgroups(NGROUPS,gary); - while (--i >= 0) - Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]); + I32 j = getgroups(NGROUPS,gary); + while (--j >= 0) + Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]); } #endif (void)SvIOK_on(sv); /* what a wonderful hack! */ @@ -270,7 +270,6 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) { const UV max_div_16 = UV_MAX / 16; const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; bool overflowed = FALSE; - const char *hexdigit; if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { /* strip off leading x or 0x. @@ -289,7 +288,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) { } for (; len-- && *s; s++) { - hexdigit = strchr(PL_hexdigit, *s); + const char *hexdigit = strchr(PL_hexdigit, *s); if (hexdigit) { /* Write it in this wonky order with a goto to attempt to get the compiler to make the common case integer-only loop pretty tight. @@ -2551,20 +2551,21 @@ char * Perl_moreswitches(pTHX_ char *s) { dVAR; - STRLEN numlen; UV rschar; switch (*s) { case '0': { I32 flags = 0; + STRLEN numlen; SvREFCNT_dec(PL_rs); if (s[1] == 'x' && s[2]) { - char *e; + const char *e = s+=2; U8 *tmps; - for (s += 2, e = s; *e; e++); + while (*e) + e++; numlen = e - s; flags = PERL_SCAN_SILENT_ILLDIGIT; rschar = (U32)grok_hex(s, &numlen, &flags, NULL); @@ -2719,6 +2720,7 @@ Perl_moreswitches(pTHX_ char *s) } if (isDIGIT(*s)) { I32 flags = 0; + STRLEN numlen; PL_ors_sv = newSVpvn("\n",1); numlen = 3 + (*s == '0'); *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL); @@ -168,6 +168,9 @@ # define pTHX_4 5 # define pTHX_5 6 # define pTHX_6 7 +# define pTHX_7 8 +# define pTHX_8 9 +# define pTHX_9 10 #endif #define STATIC static @@ -213,7 +216,7 @@ * for silencing unused variables that are actually used most of the time, * but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs */ -#define PERL_UNUSED_VAR(var) if (0) var = var +#define PERL_UNUSED_VAR(var) ((void)var) #define NOOP (void)0 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL @@ -231,6 +234,9 @@ # define pTHX_4 4 # define pTHX_5 5 # define pTHX_6 6 +# define pTHX_7 7 +# define pTHX_8 8 +# define pTHX_9 9 #endif #ifndef dVAR diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 0da12ba10e..f5533b9700 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2042,7 +2042,7 @@ C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary number may use '_' characters to separate digits. - UV grok_bin(const char* start, STRLEN* len, I32* flags, NV *result) + UV grok_bin(const char* start, STRLEN* len_p, I32* flags, NV *result) =for hackers Found in file numeric.c @@ -2070,7 +2070,7 @@ C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex number may use '_' characters to separate digits. - UV grok_hex(const char* start, STRLEN* len, I32* flags, NV *result) + UV grok_hex(const char* start, STRLEN* len_p, I32* flags, NV *result) =for hackers Found in file numeric.c @@ -2130,7 +2130,7 @@ is NULL). If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the octal number may use '_' characters to separate digits. - UV grok_oct(const char* start, STRLEN* len, I32* flags, NV *result) + UV grok_oct(const char* start, STRLEN* len_p, I32* flags, NV *result) =for hackers Found in file numeric.c @@ -68,8 +68,7 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>. #define dSP register SV **sp = PL_stack_sp #define djSP dSP #define dMARK register SV **mark = PL_stack_base + POPMARK -#define dORIGMARK I32 origmark = mark - PL_stack_base -#define SETORIGMARK origmark = mark - PL_stack_base +#define dORIGMARK const I32 origmark = mark - PL_stack_base #define ORIGMARK (PL_stack_base + origmark) #define SPAGAIN sp = PL_stack_sp @@ -208,7 +208,7 @@ PP(pp_substcont) RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ)); if (cx->sb_iters++) { - I32 saviters = cx->sb_iters; + const I32 saviters = cx->sb_iters; if (cx->sb_iters > cx->sb_maxiters) DIE(aTHX_ "Substitution loop"); @@ -329,9 +329,8 @@ PP(pp_dor) { /* Most of this is lifted straight from pp_defined */ dSP; - register SV* sv; + register SV* const sv = TOPs; - sv = TOPs; if (!sv || !SvANY(sv)) { --SP; RETURNOP(cLOGOP->op_other); @@ -434,7 +433,7 @@ PP(pp_add) if ((auvok = SvUOK(TOPm1s))) auv = SvUVX(TOPm1s); else { - register IV aiv = SvIVX(TOPm1s); + register const IV aiv = SvIVX(TOPm1s); if (aiv >= 0) { auv = aiv; auvok = 1; /* Now acting as a sign flag. */ @@ -454,7 +453,7 @@ PP(pp_add) if (buvok) buv = SvUVX(TOPs); else { - register IV biv = SvIVX(TOPs); + register const IV biv = SvIVX(TOPs); if (biv >= 0) { buv = biv; buvok = 1; @@ -528,7 +527,7 @@ PP(pp_aelemfast) dSP; AV *av = PL_op->op_flags & OPf_SPECIAL ? (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); - U32 lval = PL_op->op_flags & OPf_MOD; + const U32 lval = PL_op->op_flags & OPf_MOD; SV** svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); EXTEND(SP, 1); @@ -770,7 +769,7 @@ PP(pp_rv2av) } if (GIMME == G_ARRAY) { - I32 maxarg = AvFILL(av) + 1; + const I32 maxarg = AvFILL(av) + 1; (void)POPs; /* XXXX May be optimized away? */ EXTEND(SP, maxarg); if (SvRMAGICAL(av)) { @@ -790,7 +789,7 @@ PP(pp_rv2av) } else if (GIMME_V == G_SCALAR) { dTARGET; - I32 maxarg = AvFILL(av) + 1; + const I32 maxarg = AvFILL(av) + 1; SETi(maxarg); } RETURN; @@ -800,7 +799,8 @@ PP(pp_rv2hv) { dSP; dTOPss; HV *hv; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; + static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context"; if (SvROK(sv)) { wasref: @@ -815,7 +815,7 @@ PP(pp_rv2hv) } else if (LVRET) { if (gimme != G_ARRAY) - Perl_croak(aTHX_ "Can't return hash to lvalue scalar context"); + Perl_croak(aTHX_ return_hash_to_lvalue_scalar ); SETs((SV*)hv); RETURN; } @@ -832,8 +832,7 @@ PP(pp_rv2hv) } else if (LVRET) { if (gimme != G_ARRAY) - Perl_croak(aTHX_ "Can't return hash to lvalue" - " scalar context"); + Perl_croak(aTHX_ return_hash_to_lvalue_scalar ); SETs((SV*)hv); RETURN; } @@ -888,8 +887,7 @@ PP(pp_rv2hv) } else if (LVRET) { if (gimme != G_ARRAY) - Perl_croak(aTHX_ "Can't return hash to lvalue" - " scalar context"); + Perl_croak(aTHX_ return_hash_to_lvalue_scalar ); SETs((SV*)hv); RETURN; } @@ -916,17 +914,17 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) HE *didstore; if (ckWARN(WARN_MISC)) { + const char *err; if (relem == firstrelem && SvROK(*relem) && (SvTYPE(SvRV(*relem)) == SVt_PVAV || SvTYPE(SvRV(*relem)) == SVt_PVHV)) { - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Reference found where even-sized list expected"); + err = "Reference found where even-sized list expected"; } else - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Odd number of elements in hash assignment"); + err = "Odd number of elements in hash assignment"; + Perl_warner(aTHX_ packWARN(WARN_MISC), err); } tmpstr = NEWSV(29,0); @@ -1186,10 +1184,10 @@ PP(pp_match) char *truebase; /* Start of string */ register REGEXP *rx = PM_GETRE(pm); bool rxtainted; - I32 gimme = GIMME; + const I32 gimme = GIMME; STRLEN len; I32 minmatch = 0; - I32 oldsave = PL_savestack_ix; + const I32 oldsave = PL_savestack_ix; I32 update_minmatch = 1; I32 had_zerolen = 0; @@ -1294,13 +1292,10 @@ play_it_again: RX_MATCH_TAINTED_on(rx); TAINT_IF(RX_MATCH_TAINTED(rx)); if (gimme == G_ARRAY) { - I32 nparens, i, len; + const I32 nparens = rx->nparens; + I32 i = (global && !nparens) ? 1 : 0; + I32 len; - nparens = rx->nparens; - if (global && !nparens) - i = 1; - else - i = 0; SPAGAIN; /* EVAL blocks could move the stack. */ EXTEND(SP, nparens + i); EXTEND_MORTAL(nparens + i); @@ -1449,9 +1444,9 @@ Perl_do_readline(pTHX) STRLEN tmplen = 0; STRLEN offset; PerlIO *fp; - register IO *io = GvIO(PL_last_in_gv); - register I32 type = PL_op->op_type; - I32 gimme = GIMME_V; + register IO * const io = GvIO(PL_last_in_gv); + register const I32 type = PL_op->op_type; + const I32 gimme = GIMME_V; MAGIC *mg; if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { @@ -1668,13 +1663,13 @@ PP(pp_helem) SV **svp; SV *keysv = POPs; HV *hv = (HV*)POPs; - U32 lval = PL_op->op_flags & OPf_MOD || LVRET; - U32 defer = PL_op->op_private & OPpLVAL_DEFER; + const U32 lval = PL_op->op_flags & OPf_MOD || LVRET; + const U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; #ifdef PERL_COPY_ON_WRITE - U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0; + const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0; #else - U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; + const U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; #endif I32 preeminent = 0; @@ -1727,7 +1722,7 @@ PP(pp_helem) else { if (!preeminent) { STRLEN keylen; - char *key = SvPV(keysv, keylen); + const char * const key = SvPV(keysv, keylen); SAVEDELETE(hv, savepvn(key,keylen), keylen); } else save_helem(hv, keysv, svp); @@ -1753,7 +1748,6 @@ PP(pp_leave) { dVAR; dSP; register PERL_CONTEXT *cx; - register SV **mark; SV **newsp; PMOP *newpm; I32 gimme; @@ -1777,6 +1771,7 @@ PP(pp_leave) if (gimme == G_VOID) SP = newsp; else if (gimme == G_SCALAR) { + register SV **mark; MARK = newsp + 1; if (MARK <= SP) { if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) @@ -1791,6 +1786,7 @@ PP(pp_leave) } else if (gimme == G_ARRAY) { /* in case LEAVE wipes old return values */ + register SV **mark; for (mark = newsp + 1; mark <= SP; mark++) { if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) { *mark = sv_mortalcopy(*mark); @@ -2778,10 +2774,8 @@ PP(pp_entersub) /* Need to copy @_ to stack. Alternative may be to * switch stack to @_, and copy return values * back. This would allow popping @_ in XSUB, e.g.. XXXX */ - AV* av; - I32 items; - av = GvAV(PL_defgv); - items = AvFILLp(av) + 1; /* @_ is not tieable */ + AV * const av = GvAV(PL_defgv); + const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */ if (items) { /* Mark is at the end of the stack. */ @@ -2867,7 +2861,7 @@ PP(pp_aelem) { dSP; SV** svp; - SV* elemsv = POPs; + SV* const elemsv = POPs; IV elem = SvIV(elemsv); AV* av = (AV*)POPs; const U32 lval = PL_op->op_flags & OPf_MOD || LVRET; @@ -2883,16 +2877,17 @@ PP(pp_aelem) svp = av_fetch(av, elem, lval && !defer); if (lval) { #ifdef PERL_MALLOC_WRAP - static const char oom_array_extend[] = - "Out of memory during array extend"; /* Duplicated in av.c */ if (SvUOK(elemsv)) { const UV uv = SvUV(elemsv); elem = uv > IV_MAX ? IV_MAX : uv; } else if (SvNOK(elemsv)) elem = (IV)SvNV(elemsv); - if (elem > 0) + if (elem > 0) { + static const char oom_array_extend[] = + "Out of memory during array extend"; /* Duplicated in av.c */ MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend); + } #endif if (!svp || *svp == &PL_sv_undef) { SV* lv; @@ -76,29 +76,61 @@ PERL_CALLCONV OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last PERL_CALLCONV I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp); PERL_CALLCONV void Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv, const char *attrstr, STRLEN len); PERL_CALLCONV void Perl_av_clear(pTHX_ AV* ar); -PERL_CALLCONV SV* Perl_av_delete(pTHX_ AV* ar, I32 key, I32 flags); -PERL_CALLCONV bool Perl_av_exists(pTHX_ AV* ar, I32 key); -PERL_CALLCONV void Perl_av_extend(pTHX_ AV* ar, I32 key); -PERL_CALLCONV AV* Perl_av_fake(pTHX_ I32 size, SV** svp); -PERL_CALLCONV SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval); +PERL_CALLCONV SV* Perl_av_delete(pTHX_ AV* ar, I32 key, I32 flags) + __attribute__((warn_unused_result)); + +PERL_CALLCONV bool Perl_av_exists(pTHX_ AV* ar, I32 key) + __attribute__((warn_unused_result)); + +PERL_CALLCONV void Perl_av_extend(pTHX_ AV* ar, I32 key) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV AV* Perl_av_fake(pTHX_ I32 size, SV** svp) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_2))); + +PERL_CALLCONV SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_av_fill(pTHX_ AV* ar, I32 fill); -PERL_CALLCONV I32 Perl_av_len(pTHX_ const AV* ar); -PERL_CALLCONV AV* Perl_av_make(pTHX_ I32 size, SV** svp); -PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV* ar); +PERL_CALLCONV I32 Perl_av_len(pTHX_ const AV* ar) + __attribute__((warn_unused_result)); + +PERL_CALLCONV AV* Perl_av_make(pTHX_ I32 size, SV** svp) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_2))); + +PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV* ar) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_av_push(pTHX_ AV* ar, SV* val); PERL_CALLCONV void Perl_av_reify(pTHX_ AV* ar); -PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar); +PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar) + __attribute__((warn_unused_result)); + PERL_CALLCONV SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val); PERL_CALLCONV void Perl_av_undef(pTHX_ AV* ar); PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num); -PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat); -PERL_CALLCONV OP* Perl_block_end(pTHX_ I32 floor, OP* seq); -PERL_CALLCONV I32 Perl_block_gimme(pTHX); -PERL_CALLCONV int Perl_block_start(pTHX_ int full); +PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_2,pTHX_3))); + +PERL_CALLCONV OP* Perl_block_end(pTHX_ I32 floor, OP* seq) + __attribute__((warn_unused_result)); + +PERL_CALLCONV I32 Perl_block_gimme(pTHX) + __attribute__((warn_unused_result)); + +PERL_CALLCONV int Perl_block_start(pTHX_ int full) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_boot_core_UNIVERSAL(pTHX); PERL_CALLCONV void Perl_boot_core_PerlIO(pTHX); -PERL_CALLCONV void Perl_call_list(pTHX_ I32 oldscope, AV* av_list); +PERL_CALLCONV void Perl_call_list(pTHX_ I32 oldscope, AV* av_list) + __attribute__((nonnull(pTHX_2))); + PERL_CALLCONV bool Perl_cando(pTHX_ Mode_t mode, Uid_t effective, const Stat_t* statbufp) + __attribute__((warn_unused_result)) __attribute__((nonnull(pTHX_3))); PERL_CALLCONV U32 Perl_cast_ulong(pTHX_ NV f); @@ -162,7 +194,9 @@ PERL_CALLCONV int Perl_printf_nocontext(const char* fmt, ...) __attribute__format__(__printf__,1,2); #endif -PERL_CALLCONV void Perl_cv_ckproto(pTHX_ const CV* cv, const GV* gv, const char* p); +PERL_CALLCONV void Perl_cv_ckproto(pTHX_ const CV* cv, const GV* gv, const char* p) + __attribute__((nonnull(pTHX_1))); + PERL_CALLCONV CV* Perl_cv_clone(pTHX_ CV* proto) __attribute__((nonnull(pTHX_1))); @@ -174,21 +208,28 @@ PERL_CALLCONV SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv); PERL_CALLCONV void Perl_filter_del(pTHX_ filter_t funcp); PERL_CALLCONV I32 Perl_filter_read(pTHX_ int idx, SV* buffer, int maxlen); PERL_CALLCONV char** Perl_get_op_descs(pTHX) + __attribute__((warn_unused_result)) __attribute__((pure)); PERL_CALLCONV char** Perl_get_op_names(pTHX) + __attribute__((warn_unused_result)) __attribute__((pure)); PERL_CALLCONV const char* Perl_get_no_modify(pTHX) + __attribute__((warn_unused_result)) __attribute__((pure)); PERL_CALLCONV U32* Perl_get_opargs(pTHX) + __attribute__((warn_unused_result)) __attribute__((pure)); PERL_CALLCONV PPADDR_t* Perl_get_ppaddr(pTHX) + __attribute__((warn_unused_result)) __attribute__((pure)); -PERL_CALLCONV I32 Perl_cxinc(pTHX); +PERL_CALLCONV I32 Perl_cxinc(pTHX) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_deb(pTHX_ const char* pat, ...) __attribute__format__(__printf__,pTHX_1,pTHX_2); @@ -335,15 +376,39 @@ PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen); PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash); PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval); PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash); -PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry); -PERL_CALLCONV I32 Perl_hv_iterinit(pTHX_ HV* tb); -PERL_CALLCONV char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen); -PERL_CALLCONV SV* Perl_hv_iterkeysv(pTHX_ HE* entry); -PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb); -PERL_CALLCONV SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen); -PERL_CALLCONV HE* Perl_hv_iternext_flags(pTHX_ HV* tb, I32 flags); -PERL_CALLCONV SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry); -PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax); +PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV I32 Perl_hv_iterinit(pTHX_ HV* tb) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_2))); + +PERL_CALLCONV SV* Perl_hv_iterkeysv(pTHX_ HE* entry) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3))); + +PERL_CALLCONV HE* Perl_hv_iternext_flags(pTHX_ HV* tb, I32 flags) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_2))); + +PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax) + __attribute__((nonnull(pTHX_1))); + PERL_CALLCONV void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how); PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash); PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); @@ -599,17 +664,17 @@ PERL_CALLCONV I32 Perl_looks_like_number(pTHX_ SV* sv) __attribute__((warn_unused_result)) __attribute__((nonnull(pTHX_1))); -PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len, I32* flags, NV *result) +PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result) __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3))); -PERL_CALLCONV UV Perl_grok_hex(pTHX_ const char* start, STRLEN* len, I32* flags, NV *result) +PERL_CALLCONV UV Perl_grok_hex(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result) __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3))); PERL_CALLCONV int Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) __attribute__((nonnull(pTHX_1))); PERL_CALLCONV bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send); -PERL_CALLCONV UV Perl_grok_oct(pTHX_ const char* start, STRLEN* len, I32* flags, NV *result); +PERL_CALLCONV UV Perl_grok_oct(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result); PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg); @@ -1059,7 +1124,7 @@ PERL_CALLCONV OP* Perl_refkids(pTHX_ OP* o, I32 type); PERL_CALLCONV void Perl_regdump(pTHX_ regexp* r) __attribute__((nonnull(pTHX_1))); -PERL_CALLCONV SV* Perl_regclass_swash(pTHX_ struct regnode *n, bool doinit, SV **listsvp, SV **altsvp); +PERL_CALLCONV SV* Perl_regclass_swash(pTHX_ const struct regnode *n, bool doinit, SV **listsvp, SV **altsvp); PERL_CALLCONV I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave) __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_4,pTHX_6))); @@ -1069,22 +1134,31 @@ PERL_CALLCONV regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm) PERL_CALLCONV char* Perl_re_intuit_start(pTHX_ regexp* prog, SV* sv, char* strpos, char* strend, U32 flags, struct re_scream_pos_data_s *data); PERL_CALLCONV SV* Perl_re_intuit_string(pTHX_ regexp* prog); -PERL_CALLCONV I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags); +PERL_CALLCONV I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_4))); + PERL_CALLCONV regnode* Perl_regnext(pTHX_ regnode* p); -PERL_CALLCONV void Perl_regprop(pTHX_ SV* sv, regnode* o); +PERL_CALLCONV void Perl_regprop(pTHX_ SV* sv, const regnode* o); PERL_CALLCONV void Perl_repeatcpy(pTHX_ char* to, const char* from, I32 len, I32 count) __attribute__((nonnull(pTHX_1,pTHX_2))); PERL_CALLCONV char* Perl_rninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend) - __attribute__((pure)); + __attribute__((pure)) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_4))); PERL_CALLCONV Sighandler_t Perl_rsignal(pTHX_ int i, Sighandler_t t); PERL_CALLCONV int Perl_rsignal_restore(pTHX_ int i, Sigsave_t* t); PERL_CALLCONV int Perl_rsignal_save(pTHX_ int i, Sighandler_t t1, Sigsave_t* t2); PERL_CALLCONV Sighandler_t Perl_rsignal_state(pTHX_ int i); -PERL_CALLCONV void Perl_rxres_free(pTHX_ void** rsp); -PERL_CALLCONV void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx); -PERL_CALLCONV void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx); +PERL_CALLCONV void Perl_rxres_free(pTHX_ void** rsp) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx) + __attribute__((nonnull(pTHX_1,pTHX_2))); + +PERL_CALLCONV void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx) + __attribute__((nonnull(pTHX_1,pTHX_2))); + #if !defined(HAS_RENAME) PERL_CALLCONV I32 Perl_same_dirent(pTHX_ const char* a, const char* b) __attribute__((nonnull(pTHX_1,pTHX_2))); @@ -1159,7 +1233,9 @@ PERL_CALLCONV Signal_t Perl_csighandler(int sig); PERL_CALLCONV SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n) __attribute__((nonnull(pTHX_1,pTHX_2))); -PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags); +PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_sub_crush_depth(pTHX_ CV* cv); PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv) __attribute__((nonnull(pTHX_1))); @@ -1281,6 +1357,7 @@ PERL_CALLCONV void Perl_sv_dump(pTHX_ SV* sv) __attribute__((nonnull(pTHX_1))); PERL_CALLCONV bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name) + __attribute__((warn_unused_result)) __attribute__((nonnull(pTHX_1,pTHX_2))); PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2) @@ -1336,8 +1413,13 @@ PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_recode_to_utf8(pTHX_ SV* sv, SV *encoding); PERL_CALLCONV bool Perl_sv_cat_decode(pTHX_ SV* dsv, SV *encoding, SV *ssv, int *offset, char* tstr, int tlen); -PERL_CALLCONV char* Perl_sv_reftype(pTHX_ const SV* sv, int ob); -PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv); +PERL_CALLCONV char* Perl_sv_reftype(pTHX_ const SV* sv, int ob) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv) + __attribute__((nonnull(pTHX_1,pTHX_2))); + PERL_CALLCONV void Perl_sv_report_used(pTHX); PERL_CALLCONV void Perl_sv_reset(pTHX_ const char* s, HV* stash); PERL_CALLCONV void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...) @@ -1415,14 +1497,17 @@ PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* idop PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen); PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen); PERL_CALLCONV STRLEN Perl_utf8_length(pTHX_ const U8* s, const U8 *e) + __attribute__((warn_unused_result)) __attribute__((pure)) __attribute__((nonnull(pTHX_1,pTHX_2))); PERL_CALLCONV IV Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) + __attribute__((warn_unused_result)) __attribute__((pure)) __attribute__((nonnull(pTHX_1,pTHX_2))); PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ const U8 *s, I32 off) + __attribute__((warn_unused_result)) __attribute__((pure)) __attribute__((nonnull(pTHX_1))); @@ -1448,7 +1533,9 @@ PERL_CALLCONV U8* Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) __attribute__((nonnull(pTHX_1))); PERL_CALLCONV char* Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV flags); -PERL_CALLCONV char* Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags); +PERL_CALLCONV char* Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv); PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what); PERL_CALLCONV I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags); @@ -1629,7 +1716,9 @@ STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv) #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) STATIC void S_gv_init_sv(pTHX_ GV *gv, I32 sv_type); -STATIC void S_require_errno(pTHX_ GV *gv); +STATIC void S_require_errno(pTHX_ GV *gv) + __attribute__((nonnull(pTHX_1))); + #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) @@ -1779,7 +1868,10 @@ STATIC regnode* S_regatom(pTHX_ struct RExC_state_t*, I32 *); STATIC regnode* S_regbranch(pTHX_ struct RExC_state_t*, I32 *, I32); STATIC void S_reguni(pTHX_ struct RExC_state_t*, UV, char *, STRLEN*); STATIC regnode* S_regclass(pTHX_ struct RExC_state_t*); -STATIC I32 S_regcurly(pTHX_ char *); +STATIC I32 S_regcurly(pTHX_ const char *) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + STATIC regnode* S_reg_node(pTHX_ struct RExC_state_t*, U8); STATIC regnode* S_regpiece(pTHX_ struct RExC_state_t*, I32 *); STATIC void S_reginsert(pTHX_ struct RExC_state_t*, U8, regnode *); @@ -1810,22 +1902,52 @@ STATIC I32 S_make_trie(pTHX_ struct RExC_state_t*, regnode *startbranch, regnode #endif #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) -STATIC I32 S_regmatch(pTHX_ regnode *prog); -STATIC I32 S_regrepeat(pTHX_ regnode *p, I32 max); -STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp); -STATIC I32 S_regtry(pTHX_ regexp *prog, char *startpos); -STATIC bool S_reginclass(pTHX_ regnode *n, U8 *p, STRLEN *lenp, bool do_utf8sv_is_utf8); +STATIC I32 S_regmatch(pTHX_ regnode *prog) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +STATIC I32 S_regrepeat(pTHX_ const regnode *p, I32 max) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + +STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_3))); + +STATIC I32 S_regtry(pTHX_ regexp *prog, char *startpos) + __attribute__((warn_unused_result)); + +STATIC bool S_reginclass(pTHX_ const regnode *n, const U8 *p, STRLEN *lenp, bool do_utf8sv_is_utf8) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_2))); + STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor); STATIC char* S_regcppop(pTHX); STATIC char* S_regcp_set_to(pTHX_ I32 ss); STATIC void S_cache_re(pTHX_ regexp *prog); -STATIC U8* S_reghop(pTHX_ U8 *pos, I32 off); -STATIC U8* S_reghop3(pTHX_ U8 *pos, I32 off, U8 *lim); -STATIC U8* S_reghopmaybe(pTHX_ U8 *pos, I32 off); -STATIC U8* S_reghopmaybe3(pTHX_ U8 *pos, I32 off, U8 *lim); -STATIC char* S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun); -STATIC void S_to_utf8_substr(pTHX_ regexp * prog); -STATIC void S_to_byte_substr(pTHX_ regexp * prog); +STATIC U8* S_reghop(pTHX_ U8 *pos, I32 off) + __attribute__((warn_unused_result)); + +STATIC U8* S_reghop3(pTHX_ U8 *pos, I32 off, U8 *lim) + __attribute__((warn_unused_result)); + +STATIC U8* S_reghopmaybe(pTHX_ U8 *pos, I32 off) + __attribute__((warn_unused_result)); + +STATIC U8* S_reghopmaybe3(pTHX_ U8 *pos, I32 off, U8 *lim) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_3))); + +STATIC char* S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_4))); + +STATIC void S_to_utf8_substr(pTHX_ regexp * prog) + __attribute__((nonnull(pTHX_1))); + +STATIC void S_to_byte_substr(pTHX_ regexp * prog) + __attribute__((nonnull(pTHX_1))); + #endif #if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) @@ -1871,19 +1993,29 @@ STATIC void S_not_a_number(pTHX_ SV *sv); STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask); STATIC void S_sv_add_backref(pTHX_ SV *tsv, SV *sv); STATIC void S_sv_del_backref(pTHX_ SV *sv); +STATIC SV * S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ, SV *keyname, I32 aindex, int subscript_type) + __attribute__((nonnull(pTHX_2))); + # ifdef DEBUGGING STATIC void S_del_sv(pTHX_ SV *p); # endif # if !defined(NV_PRESERVES_UV) STATIC int S_sv_2iuv_non_preserve(pTHX_ SV *sv, I32 numtype); # endif -STATIC I32 S_expect_number(pTHX_ char** pattern); +STATIC I32 S_expect_number(pTHX_ char** pattern) + __attribute__((warn_unused_result)) + __attribute__((nonnull(pTHX_1))); + # # if defined(USE_ITHREADS) STATIC SV* S_gv_share(pTHX_ SV *sv, CLONE_PARAMS *param); # endif -STATIC bool S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, U8 **sp, U8 *start, U8 *send); -STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, U8 *s, U8 *start); +STATIC bool S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, U8 **sp, U8 *start, U8 *send) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_5,pTHX_7,pTHX_8,pTHX_9))); + +STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, U8 *s, U8 *start) + __attribute__((nonnull(pTHX_1,pTHX_2,pTHX_3,pTHX_6,pTHX_7))); + #if defined(PERL_COPY_ON_WRITE) STATIC void S_sv_release_COW(pTHX_ SV *sv, char *pvx, STRLEN cur, STRLEN len, U32 hash, SV *after); #endif @@ -2053,7 +2185,9 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, in STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title); # endif #endif -PERL_CALLCONV CV* Perl_find_runcv(pTHX_ U32 *db_seqp); +PERL_CALLCONV CV* Perl_find_runcv(pTHX_ U32 *db_seqp) + __attribute__((warn_unused_result)); + PERL_CALLCONV void Perl_free_tied_hv_pool(pTHX); #if defined(DEBUGGING) PERL_CALLCONV int Perl_get_debug_opts(pTHX_ const char **s, bool givehelp); @@ -1370,7 +1370,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs demq */ - U32 laststate = TRIE_NODENUM( next_alloc ); + const U32 laststate = TRIE_NODENUM( next_alloc ); U32 used , state, charid; U32 pos = 0, zp=0; trie->laststate = laststate; @@ -1606,7 +1606,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg n = regnext(n); } else if (stringok) { - int oldl = STR_LEN(scan); + const int oldl = STR_LEN(scan); regnode *nnext = regnext(n); if (oldl + STR_LEN(n) > U8_MAX) @@ -1684,7 +1684,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* Follow the next-chain of the current node and optimize away all the NOTHINGs from it. */ if (OP(scan) != CURLYX) { - int max = (reg_off_by_arg[OP(scan)] + const int max = (reg_off_by_arg[OP(scan)] ? I32_MAX /* I32 may be smaller than U16 on CRAYs! */ : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); @@ -1999,7 +1999,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg I32 l = STR_LEN(scan); UV uc = *((U8*)STRING(scan)); if (UTF) { - U8 *s = (U8*)STRING(scan); + const U8 * const s = (U8*)STRING(scan); l = utf8_length(s, s + l); uc = utf8_to_uvchr(s, NULL); } @@ -5656,7 +5656,7 @@ S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) - regcurly - a little FSA that accepts {\d+,?\d*} */ STATIC I32 -S_regcurly(pTHX_ register char *s) +S_regcurly(pTHX_ register const char *s) { if (*s++ != '{') return FALSE; @@ -5907,7 +5907,7 @@ S_put_byte(pTHX_ SV *sv, int c) - regprop - printable representation of opcode */ void -Perl_regprop(pTHX_ SV *sv, regnode *o) +Perl_regprop(pTHX_ SV *sv, const regnode *o) { #ifdef DEBUGGING register int k; @@ -174,9 +174,9 @@ static void restore_pos(pTHX_ void *arg); STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor) { - int retval = PL_savestack_ix; + const int retval = PL_savestack_ix; #define REGCP_PAREN_ELEMS 4 - int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS; + const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS; int p; if (paren_elems_to_push < 0) @@ -282,7 +282,7 @@ S_regcppop(pTHX) STATIC char * S_regcp_set_to(pTHX_ I32 ss) { - I32 tmp = PL_savestack_ix; + const I32 tmp = PL_savestack_ix; PL_savestack_ix = ss; regcppop(); @@ -406,7 +406,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, register SV *check; char *strbeg; char *t; - int do_utf8 = sv ? SvUTF8(sv) : 0; /* if no sv we have to assume bytes */ + const int do_utf8 = sv ? SvUTF8(sv) : 0; /* if no sv we have to assume bytes */ I32 ml_anch; register char *other_last = Nullch; /* other substr checked before this */ char *check_at = Nullch; /* check substr found at this pos */ @@ -523,9 +523,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, end_shift = prog->minlen - start_shift - CHR_SVLEN(check) + (SvTAIL(check) != 0); if (!ml_anch) { - I32 end = prog->check_offset_max + CHR_SVLEN(check) + const I32 end = prog->check_offset_max + CHR_SVLEN(check) - (SvTAIL(check) != 0); - I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end; + const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end; if (end_shift < eshift) end_shift = eshift; @@ -550,7 +550,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, the "check" substring in the region corrected by start/end_shift. */ if (flags & REXEC_SCREAM) { I32 p = -1; /* Internal iterator of scream. */ - I32 *pp = data ? data->scream_pos : &p; + I32 * const pp = data ? data->scream_pos : &p; if (PL_screamfirst[BmRARE(check)] >= 0 || ( BmRARE(check) == '\n' @@ -861,7 +861,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT ? CHR_DIST(str+STR_LEN(prog->regstclass), str) : 1); - char *endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch) + const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch) ? HOP3c(s, (prog->minlen ? cl_l : 0), strend) : (prog->float_substr || prog->float_utf8 ? HOP3c(HOP3c(check_at, -start_shift, strbeg), @@ -963,7 +963,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, /* We know what class REx starts with. Try to find this position... */ STATIC char * -S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun) +S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun) { dVAR; I32 doevery = (prog->reganch & ROPT_SKIP) == 0; @@ -975,7 +975,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun unsigned int c2; char *e; register I32 tmp = 1; /* Scratch variable? */ - register bool do_utf8 = PL_reg_match_utf8; + register const bool do_utf8 = PL_reg_match_utf8; /* We know what class it must start with. */ switch (OP(c)) { @@ -1639,7 +1639,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * char *scream_olds; SV* oreplsv = GvSV(PL_replgv); bool do_utf8 = DO_UTF8(sv); - I32 multiline = prog->reganch & PMf_MULTILINE; + const I32 multiline = prog->reganch & PMf_MULTILINE; #ifdef DEBUGGING SV *dsv0 = PERL_DEBUG_PAD_ZERO(0); SV *dsv1 = PERL_DEBUG_PAD_ZERO(1); @@ -2404,7 +2404,7 @@ S_regmatch(pTHX_ regnode *prog) #if 0 I32 firstcp = PL_savestack_ix; #endif - register bool do_utf8 = PL_reg_match_utf8; + const register bool do_utf8 = PL_reg_match_utf8; #ifdef DEBUGGING SV *dsv0 = PERL_DEBUG_PAD_ZERO(0); SV *dsv1 = PERL_DEBUG_PAD_ZERO(1); @@ -2580,7 +2580,7 @@ S_regmatch(pTHX_ regnode *prog) case TRIEFL: { - U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; + const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; U8 *uc = ( U8* )locinput; U32 state = 1; U16 charid = 0; @@ -2648,7 +2648,7 @@ S_regmatch(pTHX_ regnode *prog) from previous if blocks */ case TRIE: { - U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; + const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; U8 *uc = (U8*)locinput; U32 state = 1; U16 charid = 0; @@ -2794,12 +2794,12 @@ S_regmatch(pTHX_ regnode *prog) if (do_utf8 != UTF) { /* The target and the pattern have differing utf8ness. */ char *l = locinput; - char *e = s + ln; - STRLEN ulen; + const char *e = s + ln; if (do_utf8) { /* The target is utf8, the pattern is not utf8. */ while (s < e) { + STRLEN ulen; if (l >= PL_regeol) sayNO; if (NATIVE_TO_UNI(*(U8*)s) != @@ -2814,6 +2814,7 @@ S_regmatch(pTHX_ regnode *prog) else { /* The target is not utf8, the pattern is utf8. */ while (s < e) { + STRLEN ulen; if (l >= PL_regeol) sayNO; if (NATIVE_TO_UNI(*((U8*)l)) != @@ -2978,7 +2979,7 @@ S_regmatch(pTHX_ regnode *prog) if (locinput == PL_bostr) ln = '\n'; else { - U8 *r = reghop3((U8*)locinput, -1, (U8*)PL_bostr); + const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr); ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0); } @@ -3142,17 +3143,18 @@ S_regmatch(pTHX_ regnode *prog) s = PL_bostr + ln; if (do_utf8 && OP(scan) != REF) { /* REF can do byte comparison */ char *l = locinput; - char *e = PL_bostr + PL_regendp[n]; + const char *e = PL_bostr + PL_regendp[n]; /* * Note that we can't do the "other character" lookup trick as * in the 8-bit case (no pun intended) because in Unicode we * have to map both upper and title case to lower case. */ if (OP(scan) == REFF) { - STRLEN ulen1, ulen2; - U8 tmpbuf1[UTF8_MAXBYTES_CASE+1]; - U8 tmpbuf2[UTF8_MAXBYTES_CASE+1]; while (s < e) { + STRLEN ulen1, ulen2; + U8 tmpbuf1[UTF8_MAXBYTES_CASE+1]; + U8 tmpbuf2[UTF8_MAXBYTES_CASE+1]; + if (l >= PL_regeol) sayNO; toLOWER_utf8((U8*)s, tmpbuf1, &ulen1); @@ -3248,9 +3250,9 @@ S_regmatch(pTHX_ regnode *prog) STRLEN len; char *t = SvPV(ret, len); PMOP pm; - char *oprecomp = PL_regprecomp; - I32 osize = PL_regsize; - I32 onpar = PL_regnpar; + char * const oprecomp = PL_regprecomp; + const I32 osize = PL_regsize; + const I32 onpar = PL_regnpar; Zero(&pm, 1, PMOP); if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8; @@ -3539,7 +3541,7 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_leftiter = PL_reg_maxiter; } if (PL_reg_leftiter-- == 0) { - I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8; + const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8; if (PL_reg_poscache) { if ((I32)PL_reg_poscache_size < size) { Renew(PL_reg_poscache, size, char); @@ -3688,7 +3690,7 @@ S_regmatch(pTHX_ regnode *prog) if (OP(next) != c1) /* No choice. */ next = inner; /* Avoid recursion. */ else { - I32 lastparen = *PL_reglastparen; + const I32 lastparen = *PL_reglastparen; I32 unwind1; re_unwind_branch_t *uw; @@ -3998,8 +4000,8 @@ S_regmatch(pTHX_ regnode *prog) count = locinput - old; } else { - STRLEN len; if (c1 == c2) { + STRLEN len; /* count initialised to * utf8_distance(old, locinput) */ while (locinput <= e && @@ -4011,6 +4013,7 @@ S_regmatch(pTHX_ regnode *prog) count++; } } else { + STRLEN len; /* count initialised to * utf8_distance(old, locinput) */ while (locinput <= e) { @@ -4303,7 +4306,7 @@ do_no: case RE_UNWIND_BRANCHJ: { re_unwind_branch_t *uwb = &(uw->branch); - I32 lastparen = uwb->lastparen; + const I32 lastparen = uwb->lastparen; REGCP_UNWIND(uwb->lastcp); for (n = *PL_reglastparen; n > lastparen; n--) @@ -4359,7 +4362,7 @@ do_no: * rather than incrementing count on every character. [Er, except utf8.]] */ STATIC I32 -S_regrepeat(pTHX_ regnode *p, I32 max) +S_regrepeat(pTHX_ const regnode *p, I32 max) { dVAR; register char *scan; @@ -4655,14 +4658,14 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) */ SV * -Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV **altsvp) +Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) { SV *sw = NULL; SV *si = NULL; SV *alt = NULL; if (PL_regdata && PL_regdata->count) { - U32 n = ARG(node); + const U32 n = ARG(node); if (PL_regdata->what[n] == 's') { SV *rv = (SV*)PL_regdata->data[n]; @@ -4707,10 +4710,10 @@ Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV */ STATIC bool -S_reginclass(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register bool do_utf8) +S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8) { dVAR; - char flags = ANYOF_FLAGS(n); + const char flags = ANYOF_FLAGS(n); bool match = FALSE; UV c = *p; STRLEN len = 0; @@ -4744,7 +4747,7 @@ S_reginclass(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register b for (i = 0; i <= av_len(av); i++) { SV* sv = *av_fetch(av, i, FALSE); STRLEN len; - char *s = SvPV(sv, len); + const char *s = SvPV(sv, len); if (len <= plen && memEQ(s, (char*)p, len)) { *lenp = len; @@ -67,7 +67,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) I32 Perl_cxinc(pTHX) { - IV old_max = cxstack_max; + const IV old_max = cxstack_max; cxstack_max = GROW(cxstack_max); Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ /* Without any kind of initialising deep enough recursion @@ -284,12 +284,10 @@ S_del_sv(pTHX_ SV *p) { if (DEBUG_D_TEST) { SV* sva; - SV* sv; - SV* svend; - int ok = 0; + bool ok = 0; for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) { - sv = sva + 1; - svend = &sva[SvREFCNT(sva)]; + SV *sv = sva + 1; + SV *svend = &sva[SvREFCNT(sva)]; if (p >= sv && p < svend) { ok = 1; break; @@ -365,12 +363,11 @@ STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask) { SV* sva; - SV* sv; - register SV* svend; I32 visited = 0; for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) { - svend = &sva[SvREFCNT(sva)]; + register SV * const svend = &sva[SvREFCNT(sva)]; + register SV* sv; for (sv = sva + 1; sv < svend; ++sv) { if (SvTYPE(sv) != SVTYPEMASK && (sv->sv_flags & mask) == flags @@ -743,10 +740,9 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ, SV* keyname, I32 aindex, int subscript_type) { AV *av; + SV *sv; - SV *sv, *name; - - name = sv_newmortal(); + SV * const name = sv_newmortal(); if (gv) { /* simulate gv_fullname4(), but add literal '^' for $^FOO names @@ -2152,7 +2148,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen) if (newlen > SvLEN(sv)) { /* need more room? */ if (SvLEN(sv) && s) { #ifdef MYMALLOC - STRLEN l = malloced_size((void*)SvPVX(sv)); + const STRLEN l = malloced_size((void*)SvPVX(sv)); if (newlen <= l) { SvLEN_set(sv, l); return s; @@ -2423,7 +2419,7 @@ non-numeric warning), even if your atof() doesn't grok them. I32 Perl_looks_like_number(pTHX_ SV *sv) { - register char *sbegin; + register const char *sbegin; STRLEN len; if (SvPOK(sv)) { @@ -4307,19 +4303,21 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) case SVt_PVHV: case SVt_PVCV: case SVt_PVIO: + { + const char * const type = sv_reftype(sstr,0); if (PL_op) - Perl_croak(aTHX_ "Bizarre copy of %s in %s", sv_reftype(sstr, 0), - OP_NAME(PL_op)); + Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_NAME(PL_op)); else - Perl_croak(aTHX_ "Bizarre copy of %s", sv_reftype(sstr, 0)); + Perl_croak(aTHX_ "Bizarre copy of %s", type); + } break; case SVt_PVGV: if (dtype <= SVt_PVGV) { glob_assign: if (dtype != SVt_PVGV) { - char *name = GvNAME(sstr); - STRLEN len = GvNAMELEN(sstr); + const char * const name = GvNAME(sstr); + const STRLEN len = GvNAMELEN(sstr); /* don't upgrade SVt_PVLV: it can hold a glob */ if (dtype != SVt_PVLV) sv_upgrade(dstr, SVt_PVGV); @@ -4379,7 +4377,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) if (dtype == SVt_PVGV) { SV *sref = SvREFCNT_inc(SvRV(sstr)); SV *dref = 0; - int intro = GvINTRO(dstr); + const int intro = GvINTRO(dstr); #ifdef GV_UNIQUE_CHECK if (GvUNIQUE((GV*)dstr)) { @@ -4829,7 +4827,7 @@ Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN } else { /* len is STRLEN which is unsigned, need to copy to signed */ - IV iv = len; + const IV iv = len; if (iv < 0) Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen"); } @@ -5849,7 +5847,7 @@ time you'll want to use C<sv_setsv> or one of its many macro front-ends. void Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) { - U32 refcnt = SvREFCNT(sv); + const U32 refcnt = SvREFCNT(sv); SV_CHECK_THINKFIRST_COW_DROP(sv); if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Reference miscount in sv_replace()"); @@ -6273,7 +6271,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv) else { STRLEN len, ulen; - U8 *s = (U8*)SvPV(sv, len); + const U8 *s = (U8*)SvPV(sv, len); MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0; if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0)) { @@ -6307,7 +6305,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv) * */ STATIC bool -S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, U8 *s, U8 *start) +S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, U8 *s, U8 *start) { bool found = FALSE; @@ -6324,7 +6322,7 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offse } assert(*cachep); - (*cachep)[i] = *offsetp; + (*cachep)[i] = offsetp; (*cachep)[i+1] = s - start; found = TRUE; } @@ -6355,7 +6353,7 @@ S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I else { /* We will skip to the right spot. */ STRLEN forw = 0; STRLEN backw = 0; - U8* p = NULL; + const U8* p = NULL; /* The assumption is that going backward is half * the speed of going forward (that's where the @@ -6374,7 +6372,7 @@ S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I /* Try this only for the substr offset (i == 0), * not for the substr length (i == 2). */ else if (i == 0) { /* (*cachep)[i] < uoff */ - STRLEN ulen = sv_len_utf8(sv); + const STRLEN ulen = sv_len_utf8(sv); if ((STRLEN)uoff < ulen) { forw = (STRLEN)uoff - (*cachep)[i]; @@ -6495,7 +6493,7 @@ Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp) s += UTF8SKIP(s); if (s >= send) s = send; - if (utf8_mg_pos_init(sv, &mg, &cache, 0, offsetp, s, start)) + if (utf8_mg_pos_init(sv, &mg, &cache, 0, *offsetp, s, start)) boffset = cache[1]; *offsetp = s - start; } @@ -6513,7 +6511,7 @@ Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp) s += UTF8SKIP(s); if (s >= send) s = send; - utf8_mg_pos_init(sv, &mg, &cache, 2, lenp, s, start); + utf8_mg_pos_init(sv, &mg, &cache, 2, *lenp, s, start); } *lenp = s - start; } @@ -8300,7 +8298,6 @@ C<SvPV_force> and C<SvPV_force_nomg> char * Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) { - char *s = NULL; if (SvTHINKFIRST(sv) && !SvROK(sv)) sv_force_normal_flags(sv, 0); @@ -8309,6 +8306,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) *lp = SvCUR(sv); } else { + char *s; if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) { Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0), OP_NAME(PL_op)); @@ -8316,7 +8314,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) else s = sv_2pv_flags(sv, lp, flags); if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */ - STRLEN len = *lp; + const STRLEN len = *lp; if (SvROK(sv)) sv_unref(sv); @@ -8564,7 +8562,7 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname) SvAMAGIC_off(rv); if (SvTYPE(rv) >= SVt_PVMG) { - U32 refcnt = SvREFCNT(rv); + const U32 refcnt = SvREFCNT(rv); SvREFCNT(rv) = 0; sv_clear(rv); SvFLAGS(rv) = 0; @@ -9159,7 +9157,7 @@ S_expect_number(pTHX_ char** pattern) static char * F0convert(NV nv, char *endbuf, STRLEN *len) { - int neg = nv < 0; + const int neg = nv < 0; UV uv; char *p = endbuf; @@ -9171,7 +9169,7 @@ F0convert(NV nv, char *endbuf, STRLEN *len) if (uv & 1 && uv == nv) uv--; /* Round to even */ do { - unsigned dig = uv % 10; + const unsigned dig = uv % 10; *--p = '0' + dig; } while (uv /= 10); if (neg) @@ -9204,7 +9202,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV { char *p; char *q; - char *patend; + const char *patend; STRLEN origlen; I32 svix = 0; static const char nullstr[] = "(null)"; @@ -11887,7 +11885,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* Clone the regex array */ PL_regex_padav = newAV(); { - I32 len = av_len((AV*)proto_perl->Iregex_padav); + const I32 len = av_len((AV*)proto_perl->Iregex_padav); SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav); av_push(PL_regex_padav, sv_dup_inc(regexen[0],param)); @@ -12431,7 +12429,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* orphaned? eg threads->new inside BEGIN or use */ if (PL_compcv && ! SvREFCNT(PL_compcv)) { - SvREFCNT_inc(PL_compcv); + (void)SvREFCNT_inc(PL_compcv); SAVEFREESV(PL_compcv); } @@ -136,7 +136,7 @@ perform the upgrade if necessary. See C<svtype>. #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) # define SvREFCNT_inc(sv) \ ({ \ - SV *_sv = (SV*)(sv); \ + SV * const _sv = (SV*)(sv); \ if (_sv) \ (SvREFCNT(_sv))++; \ _sv; \ @@ -149,7 +149,7 @@ perform the upgrade if necessary. See C<svtype>. #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) # define SvREFCNT_dec(sv) \ ({ \ - SV *_sv = (SV*)(sv); \ + SV * const _sv = (SV*)(sv); \ if (_sv) { \ if (SvREFCNT(_sv)) { \ if (--(SvREFCNT(_sv)) == 0) \ diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index f02f58d8d8..980f5e53be 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -871,4 +871,4 @@ $t =~ s/([^a])//ge; $@ =~ s/ at .*/ at/; print $@ EXPECT -Malformed UTF-8 character (unexpected end of string) at +Malformed UTF-8 character (unexpected end of string) in substitution (s///) at @@ -10622,7 +10622,7 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { - I32 oldsavestack_ix = PL_savestack_ix; + const I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; if (PL_compcv) { diff --git a/universal.c b/universal.c index c26c835e38..fd96ce73c9 100644 --- a/universal.c +++ b/universal.c @@ -137,13 +137,10 @@ for class names as well as for objects. bool Perl_sv_derived_from(pTHX_ SV *sv, const char *name) { - const char *type; - HV *stash; + const char *type = Nullch; + HV *stash = Nullhv; HV *name_stash; - stash = Nullhv; - type = Nullch; - if (SvGMAGICAL(sv)) mg_get(sv) ; @@ -348,19 +345,18 @@ XS(XS_UNIVERSAL_VERSION) } if (items > 1) { - STRLEN len; SV *req = ST(1); if (undef) { - if (pkg) - Perl_croak(aTHX_ + if (pkg) + Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed", HvNAME(pkg), HvNAME(pkg)); - else { - const char *str = SvPVx(ST(0), len); - - Perl_croak(aTHX_ - "%s defines neither package nor VERSION--version check failed", str); + else { + STRLEN n_a; + Perl_croak(aTHX_ + "%s defines neither package nor VERSION--version check failed", + SvPVx(ST(0),n_a) ); } } @@ -238,13 +238,13 @@ Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len) { const U8* x = s; const U8* send; - STRLEN c; if (!len && s) len = strlen((const char *)s); send = s + len; while (x < send) { + STRLEN c; /* Inline the easy bits of is_utf8_char() here for speed... */ if (UTF8_IS_INVARIANT(*x)) c = 1; @@ -600,24 +600,16 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e) * the bitops (especially ~) can create illegal UTF-8. * In other words: in Perl UTF-8 is not just for Unicode. */ - if (e < s) { - if (ckWARN_d(WARN_UTF8)) { - if (PL_op) - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); - else - Perl_warner(aTHX_ packWARN(WARN_UTF8), unees); - } - return 0; - } + if (e < s) + goto warn_and_return; while (s < e) { const U8 t = UTF8SKIP(s); - if (e - s < t) { + warn_and_return: if (ckWARN_d(WARN_UTF8)) { if (PL_op) Perl_warner(aTHX_ packWARN(WARN_UTF8), - unees, OP_DESC(PL_op)); + "%s in %s", unees, OP_DESC(PL_op)); else Perl_warner(aTHX_ packWARN(WARN_UTF8), unees); } @@ -654,17 +646,8 @@ Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) if (a < b) { while (a < b) { const U8 c = UTF8SKIP(a); - - if (b - a < c) { - if (ckWARN_d(WARN_UTF8)) { - if (PL_op) - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); - else - Perl_warner(aTHX_ packWARN(WARN_UTF8), unees); - } - return off; - } + if (b - a < c) + goto warn_and_return; a += c; off--; } @@ -674,6 +657,7 @@ Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) const U8 c = UTF8SKIP(b); if (a - b < c) { + warn_and_return: if (ckWARN_d(WARN_UTF8)) { if (PL_op) Perl_warner(aTHX_ packWARN(WARN_UTF8), @@ -1865,7 +1849,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) { - unsigned char c = (unsigned char)u & 0xFF; + const unsigned char c = (unsigned char)u & 0xFF; if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) { switch (c) { case '\n': @@ -1361,10 +1361,10 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) { dVAR; if (ckDEAD(err)) { - SV *msv = vmess(pat, args); + SV * const msv = vmess(pat, args); STRLEN msglen; const char *message = SvPV(msv, msglen); - I32 utf8 = SvUTF8(msv); + const I32 utf8 = SvUTF8(msv); if (PL_diehook) { assert(message); @@ -3969,7 +3969,7 @@ Perl_new_version(pTHX_ SV *ver) AvREAL_on((AV*)sv); for ( key = 0; key <= av_len(av); key++ ) { - I32 rev = SvIV(*av_fetch(av, key, FALSE)); + const I32 rev = SvIV(*av_fetch(av, key, FALSE)); av_push((AV *)sv, newSViv(rev)); } return rv; |