diff options
-rw-r--r-- | embed.fnc | 19 | ||||
-rw-r--r-- | embed.h | 4 | ||||
-rw-r--r-- | lib/ExtUtils/CBuilder/t/01-basic.t | 2 | ||||
-rw-r--r-- | locale.c | 39 | ||||
-rw-r--r-- | mg.c | 173 | ||||
-rw-r--r-- | perlio.c | 50 | ||||
-rw-r--r-- | pp_ctl.c | 3 | ||||
-rw-r--r-- | pp_pack.c | 10 | ||||
-rw-r--r-- | pp_sys.c | 4 | ||||
-rw-r--r-- | proto.h | 39 | ||||
-rw-r--r-- | scope.c | 2 | ||||
-rw-r--r-- | taint.c | 22 | ||||
-rw-r--r-- | util.c | 10 |
13 files changed, 196 insertions, 181 deletions
@@ -246,7 +246,7 @@ Ap |char* |vform |const char* pat|va_list* args Ap |void |free_tmps p |OP* |gen_constant_list|OP* o #if !defined(HAS_GETENV_LEN) -p |char* |getenv_len |const char* key|unsigned long *len +p |char* |getenv_len |NN const char* key|NN unsigned long *len #endif Ap |void |gp_free |GV* gv Ap |GP* |gp_ref |GP* gp @@ -396,7 +396,7 @@ p |int |magic_existspack|SV* sv|MAGIC* mg p |int |magic_freeregexp|SV* sv|MAGIC* mg p |int |magic_freeovrld|SV* sv|MAGIC* mg p |int |magic_get |SV* sv|MAGIC* mg -p |int |magic_getarylen|SV* sv|MAGIC* mg +p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg p |int |magic_getdefelem|SV* sv|MAGIC* mg p |int |magic_getglob |SV* sv|MAGIC* mg p |int |magic_getnkeys |SV* sv|MAGIC* mg @@ -597,9 +597,9 @@ Apd |HV* |get_hv |const char* name|I32 create Apd |CV* |get_cv |const char* name|I32 create Ap |int |init_i18nl10n |int printwarn Ap |int |init_i18nl14n |int printwarn -Ap |void |new_collate |NN char* newcoll -Ap |void |new_ctype |NN char* newctype -Ap |void |new_numeric |NN char* newcoll +Ap |void |new_collate |NULLOK const char* newcoll +Ap |void |new_ctype |NN const char* newctype +Ap |void |new_numeric |NULLOK const char* newcoll Ap |void |set_numeric_local Ap |void |set_numeric_radix Ap |void |set_numeric_standard @@ -819,7 +819,7 @@ Ap |NV |str_to_version |SV *sv Ap |SV* |swash_init |const char* pkg|const char* name|SV* listsv|I32 minbits|I32 none Ap |UV |swash_fetch |SV *sv|const U8 *ptr|bool do_utf8 Ap |void |taint_env -Ap |void |taint_proper |const char* f|const char* s +Ap |void |taint_proper |NULLOK const char* f|NN const char* s Apd |UV |to_utf8_case |NN const U8 *p|NN U8* ustrp|STRLEN *lenp|SV **swash|const char *normal|const char *special Apd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|STRLEN *lenp Apd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|STRLEN *lenp @@ -1015,6 +1015,9 @@ s |void |save_magic |I32 mgs_ix|NN SV *sv s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth s |int |magic_methcall |NN SV *sv|NN const MAGIC *mg|NN const char *meth|I32 f \ |int n|SV *val +s |void |restore_magic |NN const void *p +s |void |unwind_handler_stack|NN const void *p + #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) @@ -1315,12 +1318,12 @@ s |SV*|isa_lookup |HV *stash|const char *name|HV *name_stash|int len|int level #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) #if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) -s |char* |stdize_locale |char* locs +s |char* |stdize_locale |NN char* locs #endif #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) -s |COP* |closest_cop |COP *cop|OP *o +s |COP* |closest_cop |NN COP *cop|NULLOK const OP *o s |SV* |mess_alloc #endif @@ -1053,6 +1053,8 @@ #define save_magic S_save_magic #define magic_methpack S_magic_methpack #define magic_methcall S_magic_methcall +#define restore_magic S_restore_magic +#define unwind_handler_stack S_unwind_handler_stack #endif #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) @@ -3016,6 +3018,8 @@ #define save_magic(a,b) S_save_magic(aTHX_ a,b) #define magic_methpack(a,b,c) S_magic_methpack(aTHX_ a,b,c) #define magic_methcall(a,b,c,d,e,f) S_magic_methcall(aTHX_ a,b,c,d,e,f) +#define restore_magic(a) S_restore_magic(aTHX_ a) +#define unwind_handler_stack(a) S_unwind_handler_stack(aTHX_ a) #endif #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) diff --git a/lib/ExtUtils/CBuilder/t/01-basic.t b/lib/ExtUtils/CBuilder/t/01-basic.t index b62d9e0d53..7e4b32262e 100644 --- a/lib/ExtUtils/CBuilder/t/01-basic.t +++ b/lib/ExtUtils/CBuilder/t/01-basic.t @@ -29,7 +29,7 @@ my $source_file = File::Spec->catfile('t', 'compilet.c'); { local *FH; open FH, "> $source_file" or die "Can't create $source_file: $!"; - print FH "int boot_compilet() { return 1; }\n"; + print FH "int boot_compilet(void) { return 1; }\n"; close FH; } ok -e $source_file; @@ -53,24 +53,19 @@ STATIC char * S_stdize_locale(pTHX_ char *locs) { - char *s; + const char *s = strchr(locs, '='); bool okay = TRUE; - if ((s = strchr(locs, '='))) { - char *t; - + if (s) { + const char * const t = strchr(s, '.'); okay = FALSE; - if ((t = strchr(s, '.'))) { - char *u; - - if ((u = strchr(t, '\n'))) { - - if (u[1] == 0) { - STRLEN len = u - s; - Move(s + 1, locs, len, char); - locs[len] = 0; - okay = TRUE; - } + if (t) { + const char * const u = strchr(t, '\n'); + if (u && (u[1] == 0)) { + const STRLEN len = u - s; + Move(s + 1, locs, len, char); + locs[len] = 0; + okay = TRUE; } } } @@ -112,7 +107,7 @@ Perl_set_numeric_radix(pTHX) * Set up for a new numeric locale. */ void -Perl_new_numeric(pTHX_ char *newnum) +Perl_new_numeric(pTHX_ const char *newnum) { #ifdef USE_LOCALE_NUMERIC @@ -172,7 +167,7 @@ Perl_set_numeric_local(pTHX) * Set up for a new ctype locale. */ void -Perl_new_ctype(pTHX_ char *newctype) +Perl_new_ctype(pTHX_ const char *newctype) { #ifdef USE_LOCALE_CTYPE dVAR; @@ -188,14 +183,14 @@ Perl_new_ctype(pTHX_ char *newctype) } #endif /* USE_LOCALE_CTYPE */ - (void)newctype; + PERL_UNUSED_ARG(newctype); } /* * Set up for a new collation locale. */ void -Perl_new_collate(pTHX_ char *newcoll) +Perl_new_collate(pTHX_ const char *newcoll) { #ifdef USE_LOCALE_COLLATE @@ -223,9 +218,9 @@ Perl_new_collate(pTHX_ char *newcoll) /* 50: surely no system expands a char more. */ #define XFRMBUFSIZE (2 * 50) char xbuf[XFRMBUFSIZE]; - Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE); - Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE); - SSize_t mult = fb - fa; + const Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE); + const Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE); + const SSize_t mult = fb - fa; if (mult < 1) Perl_croak(aTHX_ "strxfrm() gets absurd"); PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0; @@ -54,9 +54,6 @@ tie. Signal_t Perl_csighandler(int sig); -static void restore_magic(pTHX_ const void *p); -static void unwind_handler_stack(pTHX_ const void *p); - #ifdef __Lynx__ /* Missing protos on LynxOS */ void setruid(uid_t id); @@ -87,7 +84,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) sv_force_normal(sv); #endif - SAVEDESTRUCTOR_X(restore_magic, INT2PTR(void*, (IV)mgs_ix)); + SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix)); mgs = SSPTR(mgs_ix, MGS*); mgs->mgs_sv = sv; @@ -194,7 +191,7 @@ Perl_mg_get(pTHX_ SV *sv) } } - restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix)); + restore_magic(INT2PTR(void *, (IV)mgs_ix)); if (SvREFCNT(sv) == 1) { /* We hold the last reference to this SV, which implies that the @@ -232,7 +229,7 @@ Perl_mg_set(pTHX_ SV *sv) CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg); } - restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix)); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); return 0; } @@ -257,7 +254,7 @@ Perl_mg_length(pTHX_ SV *sv) save_magic(mgs_ix, sv); /* omit MGf_GSKIP -- not changed here */ len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg); - restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix)); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); return len; } } @@ -284,7 +281,7 @@ Perl_mg_size(pTHX_ SV *sv) save_magic(mgs_ix, sv); /* omit MGf_GSKIP -- not changed here */ len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg); - restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix)); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); return len; } } @@ -325,7 +322,7 @@ Perl_mg_clear(pTHX_ SV *sv) CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg); } - restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix)); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); return 0; } @@ -480,7 +477,7 @@ U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) { register const REGEXP *rx; - (void)sv; + PERL_UNUSED_ARG(sv); if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { if (mg->mg_obj) /* @+ */ @@ -514,7 +511,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) i = s; if (i > 0 && RX_MATCH_UTF8(rx)) { - char *b = rx->subbeg; + const char * const b = rx->subbeg; if (b) i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i)); } @@ -528,7 +525,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; (void)mg; + PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); Perl_croak(aTHX_ PL_no_modify); NORETURN_FUNCTION_END; } @@ -708,7 +705,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) } #else { - int saveerrno = errno; + const int saveerrno = errno; sv_setnv(sv, (NV)errno); sv_setpv(sv, errno ? Strerror(errno) : ""); errno = saveerrno; @@ -955,7 +952,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setpv(sv, errno ? Strerror(errno) : ""); #else { - int saveerrno = errno; + const int saveerrno = errno; sv_setnv(sv, (NV)errno); #ifdef OS2 if (errno == errno_isOS2 || errno == errno_isOS2_set) @@ -1008,7 +1005,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg) { - struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr; + struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; if (uf && uf->uf_val) (*uf->uf_val)(aTHX_ uf->uf_index, sv); @@ -1069,7 +1066,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) } #endif /* VMS */ if (s && klen == 4 && strEQ(ptr,"PATH")) { - const char *strend = s + len; + const char * const strend = s + len; while (s < strend) { char tmpbuf[256]; @@ -1095,7 +1092,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; + PERL_UNUSED_ARG(sv); my_setenv(MgPV_nolen_const(mg),Nullch); return 0; } @@ -1155,8 +1152,8 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) # endif /* PERL_IMPLICIT_SYS || WIN32 */ #endif /* VMS || EPOC */ #endif /* !PERL_MICRO */ - (void)sv; - (void)mg; + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(mg); return 0; } @@ -1172,9 +1169,8 @@ restore_sigmask(pTHX_ SV *save_sv) int Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) { - I32 i; /* Are we fetching a signal entry? */ - i = whichsig(MgPV_nolen_const(mg)); + const I32 i = whichsig(MgPV_nolen_const(mg)); if (i > 0) { if(PL_psig_ptr[i]) sv_setsv(sv,PL_psig_ptr[i]); @@ -1205,8 +1201,8 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) * refactoring might be in order. */ dVAR; - register const char *s = MgPV_nolen_const(mg); - (void)sv; + register const char * const s = MgPV_nolen_const(mg); + PERL_UNUSED_ARG(sv); if (*s == '_') { SV** svp = 0; if (strEQ(s,"__DIE__")) @@ -1216,15 +1212,14 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) else Perl_croak(aTHX_ "No such hook: %s", s); if (svp && *svp) { - SV *to_dec = *svp; + SV * const to_dec = *svp; *svp = 0; SvREFCNT_dec(to_dec); } } else { - I32 i; /* Are we clearing a signal entry? */ - i = whichsig(s); + const I32 i = whichsig(s); if (i > 0) { #ifdef HAS_SIGPROCMASK sigset_t set, save; @@ -1465,8 +1460,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; - (void)mg; + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(mg); PL_sub_generation++; return 0; } @@ -1474,8 +1469,8 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; - (void)mg; + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(mg); /* HV_badAMAGIC_on(Sv_STASH(sv)); */ PL_amagic_generation++; @@ -1487,7 +1482,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) { HV * const hv = (HV*)LvTARG(sv); I32 i = 0; - (void)mg; + PERL_UNUSED_ARG(mg); if (hv) { (void) hv_iterinit(hv); @@ -1506,7 +1501,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); if (LvTARG(sv)) { hv_ksplit((HV*)LvTARG(sv), SvIV(sv)); } @@ -1660,8 +1655,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) { dVAR; dSP; SV *retval = &PL_sv_undef; - SV *tied = SvTIED_obj((SV*)hv, mg); - HV *pkg = SvSTASH((SV*)SvRV(tied)); + SV * const tied = SvTIED_obj((SV*)hv, mg); + HV * const pkg = SvSTASH((SV*)SvRV(tied)); if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { SV *key; @@ -1693,29 +1688,27 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) int Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) { - OP *o; - I32 i; - GV* gv; - SV** svp; - - gv = PL_DBline; - i = SvTRUE(sv); - svp = av_fetch(GvAV(gv), + GV * const gv = PL_DBline; + const I32 i = SvTRUE(sv); + SV ** const svp = av_fetch(GvAV(gv), atoi(MgPV_nolen_const(mg)), FALSE); - if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) { - /* set or clear breakpoint in the relevant control op */ - if (i) - o->op_flags |= OPf_SPECIAL; - else - o->op_flags &= ~OPf_SPECIAL; + if (svp && SvIOKp(*svp)) { + OP * const o = INT2PTR(OP*,SvIVX(*svp)); + if (o) { + /* set or clear breakpoint in the relevant control op */ + if (i) + o->op_flags |= OPf_SPECIAL; + else + o->op_flags &= ~OPf_SPECIAL; + } } return 0; } int -Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg) +Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) { - AV *obj = (AV*)mg->mg_obj; + const AV * const obj = (AV*)mg->mg_obj; if (obj) { sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase); } else { @@ -1727,7 +1720,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) { - AV *obj = (AV*)mg->mg_obj; + AV * const obj = (AV*)mg->mg_obj; if (obj) { av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase); } else { @@ -1762,7 +1755,7 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) { - SV* lsv = LvTARG(sv); + SV* const lsv = LvTARG(sv); if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { mg = mg_find(lsv, PERL_MAGIC_regex_global); @@ -1781,7 +1774,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) { - SV* lsv = LvTARG(sv); + SV* const lsv = LvTARG(sv); SSize_t pos; STRLEN len; STRLEN ulen = 0; @@ -1833,7 +1826,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); if (SvFAKE(sv)) { /* FAKE globs can get coerced */ SvFAKE_off(sv); gv_efullname3(sv,((GV*)sv), "*"); @@ -1848,8 +1841,8 @@ int Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg) { GV* gv; - (void)mg; - + PERL_UNUSED_ARG(mg); + if (!SvOK(sv)) return 0; gv = gv_fetchsv(sv,TRUE, SVt_PVGV); @@ -1869,7 +1862,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) const char * const tmps = SvPV_const(lsv,len); I32 offs = LvTARGOFF(sv); I32 rem = LvTARGLEN(sv); - (void)mg; + PERL_UNUSED_ARG(mg); if (SvUTF8(lsv)) sv_pos_u2b(lsv, &offs, &rem); @@ -1891,7 +1884,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) SV * const lsv = LvTARG(sv); I32 lvoff = LvTARGOFF(sv); I32 lvlen = LvTARGLEN(sv); - (void)mg; + PERL_UNUSED_ARG(mg); if (DO_UTF8(sv)) { sv_utf8_upgrade(lsv); @@ -1919,6 +1912,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) { + PERL_UNUSED_ARG(sv); TAINT_IF(mg->mg_len & 1); return 0; } @@ -1926,7 +1920,7 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; + PERL_UNUSED_ARG(sv); if (PL_tainted) mg->mg_len |= 1; else @@ -1938,7 +1932,7 @@ int Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) { SV * const lsv = LvTARG(sv); - (void)mg; + PERL_UNUSED_ARG(mg); if (!lsv) { SvOK_off(sv); @@ -1952,7 +1946,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); do_vecset(sv); /* XXX slurp this routine */ return 0; } @@ -1963,13 +1957,13 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) SV *targ = Nullsv; if (LvTARGLEN(sv)) { if (mg->mg_obj) { - SV *ahv = LvTARG(sv); - HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0); + SV * const ahv = LvTARG(sv); + HE * const he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0); if (he) targ = HeVAL(he); } else { - AV* av = (AV*)LvTARG(sv); + AV* const av = (AV*)LvTARG(sv); if ((I32)LvTARGOFF(sv) <= AvFILL(av)) targ = AvARRAY(av)[LvTARGOFF(sv)]; } @@ -1992,7 +1986,7 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); if (LvTARGLEN(sv)) vivify_defelem(sv); if (LvTARG(sv)) { @@ -2011,15 +2005,15 @@ Perl_vivify_defelem(pTHX_ SV *sv) if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem))) return; if (mg->mg_obj) { - SV *ahv = LvTARG(sv); - HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0); + SV * const ahv = LvTARG(sv); + HE * const he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0); if (he) value = HeVAL(he); if (!value || value == &PL_sv_undef) Perl_croak(aTHX_ PL_no_helem_sv, mg->mg_obj); } else { - AV* av = (AV*)LvTARG(sv); + AV* const av = (AV*)LvTARG(sv); if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) LvTARG(sv) = Nullsv; /* array can't be extended */ else { @@ -2040,10 +2034,10 @@ Perl_vivify_defelem(pTHX_ SV *sv) int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg) { - AV *av = (AV*)mg->mg_obj; - SV **svp = AvARRAY(av); + AV * const av = (AV*)mg->mg_obj; + SV ** const svp = AvARRAY(av); I32 i = AvFILLp(av); - (void)sv; + PERL_UNUSED_ARG(sv); while (i >= 0) { if (svp[i]) { @@ -2072,7 +2066,7 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); sv_unmagic(sv, PERL_MAGIC_bm); SvVALID_off(sv); return 0; @@ -2081,7 +2075,7 @@ Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); sv_unmagic(sv, PERL_MAGIC_fm); SvCOMPILED_off(sv); return 0; @@ -2100,7 +2094,7 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) { - (void)mg; + PERL_UNUSED_ARG(mg); sv_unmagic(sv, PERL_MAGIC_qr); return 0; } @@ -2108,9 +2102,10 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg) { - regexp *re = (regexp *)mg->mg_obj; + regexp * const re = (regexp *)mg->mg_obj; + PERL_UNUSED_ARG(sv); + ReREFCNT_dec(re); - (void)sv; return 0; } @@ -2122,7 +2117,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) * RenE<eacute> Descartes said "I think not." * and vanished with a faint plop. */ - (void)sv; + PERL_UNUSED_ARG(sv); if (mg->mg_ptr) { Safefree(mg->mg_ptr); mg->mg_ptr = NULL; @@ -2136,7 +2131,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg) { - (void)sv; + PERL_UNUSED_ARG(sv); Safefree(mg->mg_ptr); /* The mg_ptr holds the pos cache. */ mg->mg_ptr = 0; mg->mg_len = -1; /* The mg_len holds the len cache. */ @@ -2316,7 +2311,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '|': { - IO *io = GvIOp(PL_defoutgv); + IO * const io = GvIOp(PL_defoutgv); if(!io) break; if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0) @@ -2615,12 +2610,12 @@ Perl_sighandler(int sig) #endif dSP; GV *gv = Nullgv; - HV *st; - SV *sv = Nullsv, *tSv = PL_Sv; + SV *sv = Nullsv; + SV * const tSv = PL_Sv; CV *cv = Nullcv; OP *myop = PL_op; U32 flags = 0; - XPV *tXpv = PL_Xpv; + XPV * const tXpv = PL_Xpv; if (PL_savestack_ix + 15 <= PL_savestack_max) flags |= 1; @@ -2639,7 +2634,7 @@ Perl_sighandler(int sig) infinity, so we fix 4 (in fact 5): */ if (flags & 1) { PL_savestack_ix += 5; /* Protect save in progress. */ - SAVEDESTRUCTOR_X(unwind_handler_stack, (void*)&flags); + SAVEDESTRUCTOR_X(S_unwind_handler_stack, (void*)&flags); } if (flags & 4) PL_markstack_ptr++; /* Protect mark. */ @@ -2647,8 +2642,10 @@ Perl_sighandler(int sig) PL_scopestack_ix += 1; /* sv_2cv is too complicated, try a simpler variant first: */ if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig])) - || SvTYPE(cv) != SVt_PVCV) + || SvTYPE(cv) != SVt_PVCV) { + HV *st; cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE); + } if (!cv || !CvROOT(cv)) { if (ckWARN(WARN_SIGNAL)) @@ -2716,10 +2713,10 @@ cleanup: static void -restore_magic(pTHX_ const void *p) +S_restore_magic(pTHX_ const void *p) { - MGS* mgs = SSPTR(PTR2IV(p), MGS*); - SV* sv = mgs->mgs_sv; + MGS* const mgs = SSPTR(PTR2IV(p), MGS*); + SV* const sv = mgs->mgs_sv; if (!sv) return; @@ -2764,7 +2761,7 @@ restore_magic(pTHX_ const void *p) } static void -unwind_handler_stack(pTHX_ const void *p) +S_unwind_handler_stack(pTHX_ const void *p) { dVAR; const U32 flags = *(const U32*)p; @@ -163,9 +163,9 @@ perlsio_binmode(FILE *fp, int iotype, int mode) else return 0; # else - (void)fp; - (void)iotype; - (void)mode; + PERL_UNUSED_ARG(fp); + PERL_UNUSED_ARG(iotype); + PERL_UNUSED_ARG(mode); return 1; # endif #endif @@ -248,9 +248,9 @@ int PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names) { #ifdef USE_SFIO - (void)iotype; - (void)mode; - (void)names; + PERL_UNUSED_ARG(iotype); + PERL_UNUSED_ARG(mode); + PERL_UNUSED_ARG(names); return 1; #else return perlsio_binmode(fp, iotype, mode); @@ -1039,9 +1039,9 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) IV PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - (void)mode; - (void)arg; - (void)tab; + PERL_UNUSED_ARG(mode); + PERL_UNUSED_ARG(arg); + PERL_UNUSED_ARG(tab); if (PerlIOValid(f)) { PerlIO_flush(f); PerlIO_pop(aTHX_ f); @@ -1216,9 +1216,9 @@ PerlIOBase_binmode(pTHX_ PerlIO *f) IV PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - (void)mode; - (void)arg; - (void)tab; + PERL_UNUSED_ARG(mode); + PERL_UNUSED_ARG(arg); + PERL_UNUSED_ARG(tab); if (PerlIOValid(f)) { PerlIO *t; @@ -1260,7 +1260,7 @@ PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, { int code = 0; while (n < max) { - PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL); + PerlIO_funcs * const tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL); if (tab) { if (!PerlIO_push(aTHX_ f, tab, mode, PerlIOArg)) { code = -1; @@ -1277,7 +1277,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) { int code = 0; if (f && names) { - PerlIO_list_t *layers = PerlIO_list_alloc(aTHX); + PerlIO_list_t * const layers = PerlIO_list_alloc(aTHX); code = PerlIO_parse_layers(aTHX_ layers, names); if (code == 0) { code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0, layers->cur); @@ -1815,8 +1815,8 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) IV PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - (void)mode; - (void)arg; + PERL_UNUSED_ARG(mode); + PERL_UNUSED_ARG(arg); if (PerlIOValid(f)) { if (tab->kind & PERLIO_K_UTF8) PerlIOBase(f)->flags |= PERLIO_F_UTF8; @@ -1894,8 +1894,8 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args) { - PerlIO_funcs *tab = PerlIO_default_btm(); - (void)self; + PerlIO_funcs * const tab = PerlIO_default_btm(); + PERL_UNUSED_ARG(self); if (tab && tab->Open) return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, old, narg, args); @@ -1982,7 +1982,7 @@ IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIOl * const l = PerlIOBase(f); - (void)arg; + PERL_UNUSED_ARG(arg); l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_TRUNCATE | PERLIO_F_APPEND); @@ -2040,7 +2040,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) IV PerlIOBase_popped(pTHX_ PerlIO *f) { - (void)f; + PERL_UNUSED_ARG(f); return 0; } @@ -2091,14 +2091,14 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) IV PerlIOBase_noop_ok(pTHX_ PerlIO *f) { - (void)f; + PERL_UNUSED_ARG(f); return 0; } IV PerlIOBase_noop_fail(pTHX_ PerlIO *f) { - (void)f; + PERL_UNUSED_ARG(f); return -1; } @@ -2952,7 +2952,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) */ # error "Don't know how to set FILE.fileno on your platform" #endif - (void)f; + PERL_UNUSED_ARG(f); return 0; # endif } @@ -4739,8 +4739,8 @@ PerlIO_getname(PerlIO *f, char *buf) } return name; #else - (void)f; - (void)buf; + PERL_UNUSED_ARG(f); + PERL_UNUSED_ARG(buf); Perl_croak(aTHX_ "Don't know how to get file name"); return Nullch; #endif @@ -2055,12 +2055,13 @@ PP(pp_last) register PERL_CONTEXT *cx; I32 pop2 = 0; I32 gimme; - I32 optype = 0; + I32 optype; OP *nextop; SV **newsp; PMOP *newpm; SV **mark; SV *sv = Nullsv; + PERL_UNUSED_VAR(optype); if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); @@ -1159,9 +1159,9 @@ I32 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags) { tempsym_t sym; - (void)strbeg; - (void)new_s; - (void)ocnt; + PERL_UNUSED_ARG(strbeg); + PERL_UNUSED_ARG(new_s); + PERL_UNUSED_ARG(ocnt); if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8; else if (need_utf8(pat, patend)) { @@ -2399,8 +2399,8 @@ void Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags) { tempsym_t sym; - (void)next_in_list; - (void)flags; + PERL_UNUSED_ARG(next_in_list); + PERL_UNUSED_ARG(flags); TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK); @@ -1318,8 +1318,8 @@ PP(pp_leavewrite) register IO * const io = GvIOp(gv); PerlIO * const ofp = IoOFP(io); PerlIO *fp; - SV **newsp = Null(SV**); - I32 gimme = 0; + SV **newsp; + I32 gimme; register PERL_CONTEXT *cx; PERL_UNUSED_VAR(newsp); PERL_UNUSED_VAR(gimme); @@ -365,7 +365,10 @@ PERL_CALLCONV char* Perl_vform(pTHX_ const char* pat, va_list* args); PERL_CALLCONV void Perl_free_tmps(pTHX); PERL_CALLCONV OP* Perl_gen_constant_list(pTHX_ OP* o); #if !defined(HAS_GETENV_LEN) -PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char* key, unsigned long *len); +PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char* key, unsigned long *len) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + #endif PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv); PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); @@ -766,7 +769,10 @@ PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_freeovrld(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_get(pTHX_ SV* sv, MAGIC* mg); -PERL_CALLCONV int Perl_magic_getarylen(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getarylen(pTHX_ SV* sv, const MAGIC* mg) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + PERL_CALLCONV int Perl_magic_getdefelem(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_getglob(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_getnkeys(pTHX_ SV* sv, MAGIC* mg); @@ -1187,15 +1193,11 @@ PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char* name, I32 create); PERL_CALLCONV CV* Perl_get_cv(pTHX_ const char* name, I32 create); PERL_CALLCONV int Perl_init_i18nl10n(pTHX_ int printwarn); PERL_CALLCONV int Perl_init_i18nl14n(pTHX_ int printwarn); -PERL_CALLCONV void Perl_new_collate(pTHX_ char* newcoll) - __attribute__nonnull__(pTHX_1); - -PERL_CALLCONV void Perl_new_ctype(pTHX_ char* newctype) - __attribute__nonnull__(pTHX_1); - -PERL_CALLCONV void Perl_new_numeric(pTHX_ char* newcoll) +PERL_CALLCONV void Perl_new_collate(pTHX_ const char* newcoll); +PERL_CALLCONV void Perl_new_ctype(pTHX_ const char* newctype) __attribute__nonnull__(pTHX_1); +PERL_CALLCONV void Perl_new_numeric(pTHX_ const char* newcoll); PERL_CALLCONV void Perl_set_numeric_local(pTHX); PERL_CALLCONV void Perl_set_numeric_radix(pTHX); PERL_CALLCONV void Perl_set_numeric_standard(pTHX); @@ -1636,7 +1638,9 @@ PERL_CALLCONV NV Perl_str_to_version(pTHX_ SV *sv); PERL_CALLCONV SV* Perl_swash_init(pTHX_ const char* pkg, const char* name, SV* listsv, I32 minbits, I32 none); PERL_CALLCONV UV Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8); PERL_CALLCONV void Perl_taint_env(pTHX); -PERL_CALLCONV void Perl_taint_proper(pTHX_ const char* f, const char* s); +PERL_CALLCONV void Perl_taint_proper(pTHX_ const char* f, const char* s) + __attribute__nonnull__(pTHX_2); + PERL_CALLCONV UV Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swash, const char *normal, const char *special) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); @@ -2031,6 +2035,13 @@ STATIC int S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); +STATIC void S_restore_magic(pTHX_ const void *p) + __attribute__nonnull__(pTHX_1); + +STATIC void S_unwind_handler_stack(pTHX_ const void *p) + __attribute__nonnull__(pTHX_1); + + #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) @@ -2695,12 +2706,16 @@ STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, HV *name_stash, int l #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) #if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) -STATIC char* S_stdize_locale(pTHX_ char* locs); +STATIC char* S_stdize_locale(pTHX_ char* locs) + __attribute__nonnull__(pTHX_1); + #endif #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) -STATIC COP* S_closest_cop(pTHX_ COP *cop, OP *o); +STATIC COP* S_closest_cop(pTHX_ COP *cop, const OP *o) + __attribute__nonnull__(pTHX_1); + STATIC SV* S_mess_alloc(pTHX); #endif @@ -430,7 +430,7 @@ SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl"); - (void)i; + PERL_UNUSED_ARG(i); NORETURN_FUNCTION_END; } @@ -24,24 +24,22 @@ void Perl_taint_proper(pTHX_ const char *f, const char *s) { - const char *ug; - #if defined(HAS_SETEUID) && defined(DEBUGGING) # if Uid_t_size == 1 { - UV uid = PL_uid; - UV euid = PL_euid; + const UV uid = PL_uid; + const UV euid = PL_euid; - DEBUG_u(PerlIO_printf(Perl_debug_log, + DEBUG_u(PerlIO_printf(Perl_debug_log, "%s %d %"UVuf" %"UVuf"\n", s, PL_tainted, uid, euid)); } # else { - IV uid = PL_uid; - IV euid = PL_euid; + const IV uid = PL_uid; + const IV euid = PL_euid; - DEBUG_u(PerlIO_printf(Perl_debug_log, + DEBUG_u(PerlIO_printf(Perl_debug_log, "%s %d %"IVdf" %"IVdf"\n", s, PL_tainted, uid, euid)); } @@ -49,6 +47,8 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) #endif if (PL_tainted) { + const char *ug; + if (!f) f = PL_no_security; if (PL_euid != PL_uid) @@ -91,7 +91,7 @@ Perl_taint_env(pTHX) if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) { const bool was_tainted = PL_tainted; - const char *name = GvENAME(PL_envgv); + const char * const name = GvENAME(PL_envgv); PL_tainted = TRUE; if (strEQ(name,"ENV")) /* hash alias */ @@ -146,7 +146,7 @@ Perl_taint_env(pTHX) STRLEN len; const bool was_tainted = PL_tainted; const char *t = SvPV_const(*svp, len); - const char *e = t + len; + const char * const e = t + len; PL_tainted = was_tainted; if (t < e && isALNUM(*t)) t++; @@ -160,7 +160,7 @@ Perl_taint_env(pTHX) #endif /* !VMS */ for (e = misc_env; *e; e++) { - svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); + SV ** 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); @@ -950,7 +950,7 @@ Perl_mess(pTHX_ const char *pat, ...) } STATIC COP* -S_closest_cop(pTHX_ COP *cop, OP *o) +S_closest_cop(pTHX_ COP *cop, const OP *o) { /* Look for PL_op starting from o. cop is the last COP we've seen. */ @@ -977,7 +977,7 @@ S_closest_cop(pTHX_ COP *cop, OP *o) /* Nothing found. */ - return 0; + return Null(COP *); } SV * @@ -2988,7 +2988,7 @@ Perl_get_context(void) void Perl_set_context(void *t) { - dVAR; + dVAR; #if defined(USE_ITHREADS) # ifdef I_MACH_CTHREADS cthread_set_data(cthread_self(), t); @@ -2997,7 +2997,7 @@ Perl_set_context(void *t) Perl_croak_nocontext("panic: pthread_setspecific"); # endif #else - (void)t; + PERL_UNUSED_ARG(t); #endif } @@ -3046,7 +3046,7 @@ Perl_get_ppaddr(pTHX) char * Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len) { - char *env_trans = PerlEnv_getenv(env_elem); + char * const env_trans = PerlEnv_getenv(env_elem); if (env_trans) *len = strlen(env_trans); return env_trans; |