From: Andy Lester Date: Wed, 30 Mar 2005 11:40:24 +0000 (-0600) Subject: const-eight.diff X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6867be6d47d7be8fc56705e4b65f064d3eef92b7;p=p5sagit%2Fp5-mst-13.2.git const-eight.diff Message-ID: <20050330174024.GA12167@petdance.com> p4raw-id: //depot/perl@24148 --- diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 95a1598..d47dfa3 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -41,7 +41,7 @@ package Maintainers; 'ni-s' => 'Nick Ing-Simmons ', 'p5p' => 'perl5-porters ', 'perlfaq' => 'perlfaq-workers ', - 'petdance' => 'Andy Lester ', + 'petdance' => 'Andy Lester ', 'pmqs' => 'Paul Marquess ', 'pvhp' => 'Peter Prymmer ', 'rclamp' => 'Richard Clamp ', diff --git a/doio.c b/doio.c index db5e52a..e9effd9 100644 --- a/doio.c +++ b/doio.c @@ -71,6 +71,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num_svs) { + (void)num_svs; return do_openn(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, &svs, 1); } @@ -156,7 +157,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, |O_TRUNC #endif ; - int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; + const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; int ismodifying; if (num_svs != 0) { @@ -1613,7 +1614,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) && s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) && (!s[3] || isSPACE(s[3]))) { - char *t = s + 3; + const char *t = s + 3; while (*t && isSPACE(*t)) ++t; @@ -1651,12 +1652,11 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) goto doshell; } { - int e = errno; - if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno)); if (do_report) { + int e = errno; PerlLIO_write(fd, (void*)&e, sizeof(int)); PerlLIO_close(fd); } @@ -1672,7 +1672,6 @@ I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { register I32 val; - register I32 val2; register I32 tot = 0; const char *what; char *s; @@ -1715,6 +1714,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) what = "chown"; APPLY_TAINT_PROPER(); if (sp - mark > 2) { + register I32 val2; val = SvIVx(*++mark); val2 = SvIVx(*++mark); APPLY_TAINT_PROPER(); @@ -1967,12 +1967,11 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { - key_t key; - I32 n, flags; + key_t key = (key_t)SvNVx(*++mark); + const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); + const I32 flags = SvIVx(*++mark); + (void)sp; - key = (key_t)SvNVx(*++mark); - n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); - flags = SvIVx(*++mark); SETERRNO(0,0); switch (optype) { @@ -2001,12 +2000,13 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { SV *astr; char *a; - I32 id, n, cmd, infosize, getinfo; + I32 infosize, getinfo; I32 ret = -1; + const I32 id = SvIVx(*++mark); + const I32 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; + const I32 cmd = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); - n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; - cmd = SvIVx(*++mark); astr = *++mark; infosize = 0; getinfo = (cmd == IPC_STAT); @@ -2125,10 +2125,11 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) #ifdef HAS_MSG SV *mstr; char *mbuf; - I32 id, msize, flags; + I32 msize, flags; STRLEN len; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; flags = SvIVx(*++mark); mbuf = SvPV(mstr, len); @@ -2148,10 +2149,11 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) SV *mstr; char *mbuf; long mtype; - I32 id, msize, flags, ret; + I32 msize, flags, ret; STRLEN len; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; /* suppress warning when reading into undef var --jhi */ if (! SvOK(mstr)) @@ -2184,10 +2186,10 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) #ifdef HAS_SEM SV *opstr; char *opbuf; - I32 id; STRLEN opsize; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); opstr = *++mark; opbuf = SvPV(opstr, opsize); if (opsize < 3 * SHORTSIZE @@ -2198,7 +2200,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) SETERRNO(0,0); /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ { - int nsops = opsize / (3 * sizeof (short)); + const int nsops = opsize / (3 * sizeof (short)); int i = nsops; short *ops = (short *) opbuf; short *o = ops; @@ -2237,11 +2239,12 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) #ifdef HAS_SHM SV *mstr; char *mbuf, *shm; - I32 id, mpos, msize; + I32 mpos, msize; STRLEN len; struct shmid_ds shmds; + const I32 id = SvIVx(*++mark); + (void)sp; - id = SvIVx(*++mark); mstr = *++mark; mpos = SvIVx(*++mark); msize = SvIVx(*++mark); diff --git a/dump.c b/dump.c index 6122ea7..31a0e03 100644 --- a/dump.c +++ b/dump.c @@ -334,7 +334,7 @@ Perl_sv_peek(pTHX_ SV *sv) } void -Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm) +Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) { char ch; @@ -402,14 +402,14 @@ Perl_pmop_dump(pTHX_ PMOP *pm) /* An op sequencer. We visit the ops in the order they're to execute. */ STATIC void -sequence(pTHX_ register OP *o) +sequence(pTHX_ register const OP *o) { SV *op; char *key; STRLEN len; static UV seq; - OP *oldop = 0, - *l; + const OP *oldop = 0; + OP *l; if (!Sequence) Sequence = newHV(); @@ -499,7 +499,7 @@ sequence(pTHX_ register OP *o) } STATIC UV -sequence_num(pTHX_ OP *o) +sequence_num(pTHX_ const OP *o) { SV *op, **seq; @@ -513,7 +513,7 @@ sequence_num(pTHX_ OP *o) } void -Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) +Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) { UV seq; sequence(aTHX_ o); @@ -856,7 +856,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } void -Perl_op_dump(pTHX_ OP *o) +Perl_op_dump(pTHX_ const OP *o) { do_op_dump(0, Perl_debug_log, o); } @@ -932,7 +932,7 @@ static struct { const char type; const char *name; } magic_names[] = { }; void -Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) +Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { for (; mg; mg = mg->mg_moremagic) { Perl_dump_indent(aTHX_ level, file, @@ -1050,7 +1050,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne } void -Perl_magic_dump(pTHX_ MAGIC *mg) +Perl_magic_dump(pTHX_ const MAGIC *mg) { do_magic_dump(0, Perl_debug_log, mg, 0, 0, 0, 0); } @@ -1586,9 +1586,8 @@ Perl_runops_debug(pTHX) } I32 -Perl_debop(pTHX_ OP *o) +Perl_debop(pTHX_ const OP *o) { - AV *padlist, *comppad; CV *cv; SV *sv; @@ -1617,8 +1616,8 @@ Perl_debop(pTHX_ OP *o) /* print the lexical's name */ cv = deb_curcv(cxstack_ix); if (cv) { - padlist = CvPADLIST(cv); - comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); + AV *padlist = CvPADLIST(cv); + AV *comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); sv = *av_fetch(comppad, o->op_targ, FALSE); } else sv = Nullsv; diff --git a/embed.fnc b/embed.fnc index f861478..13cf0ae 100644 --- a/embed.fnc +++ b/embed.fnc @@ -82,7 +82,7 @@ Ap |CV* |gv_handler |HV* stash|I32 id p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp -ApM |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len +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 @@ -137,7 +137,7 @@ Afnp |int |printf_nocontext|const char* fmt|... p |void |cv_ckproto |const CV* cv|const GV* gv|const char* p pd |CV* |cv_clone |CV* proto Apd |SV* |cv_const_sv |CV* cv -p |SV* |op_const_sv |OP* o|CV* cv +p |SV* |op_const_sv |const OP* o|CV* cv Apd |void |cv_undef |CV* cv Ap |void |cx_dump |PERL_CONTEXT* cs Ap |SV* |filter_add |filter_t funcp|SV* datasv @@ -152,7 +152,7 @@ Ep |I32 |cxinc Afp |void |deb |const char* pat|... Ap |void |vdeb |const char* pat|va_list* args Ap |void |debprofdump -Ap |I32 |debop |OP* o +Ap |I32 |debop |const OP* o Ap |I32 |debstack Ap |I32 |debstackptrs Ap |char* |delimcpy |char* to|const char* toend|const char* from \ @@ -218,7 +218,7 @@ Ap |void |dump_fds |char* s #endif Ap |void |dump_form |const GV* gv Ap |void |gv_dump |GV* gv -Ap |void |op_dump |OP* arg +Ap |void |op_dump |const OP* arg Ap |void |pmop_dump |PMOP* pm Ap |void |dump_packsubs |const HV* stash Ap |void |dump_sub |const GV* gv @@ -895,13 +895,13 @@ Ap |void |dump_vindent |I32 level|PerlIO *file|const char* pat \ Ap |void |do_gv_dump |I32 level|PerlIO *file|const char *name|GV *sv Ap |void |do_gvgv_dump |I32 level|PerlIO *file|const char *name|GV *sv Ap |void |do_hv_dump |I32 level|PerlIO *file|const char *name|HV *sv -Ap |void |do_magic_dump |I32 level|PerlIO *file|MAGIC *mg|I32 nest \ +Ap |void |do_magic_dump |I32 level|PerlIO *file|const MAGIC *mg|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim -Ap |void |do_op_dump |I32 level|PerlIO *file|OP *o -Ap |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm +Ap |void |do_op_dump |I32 level|PerlIO *file|const OP *o +Ap |void |do_pmop_dump |I32 level|PerlIO *file|const PMOP *pm Ap |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim -Ap |void |magic_dump |MAGIC *mg +Ap |void |magic_dump |const MAGIC *mg Ap |void |reginitcolors Apd |char* |sv_2pv_nolen |SV* sv Apd |char* |sv_2pvutf8_nolen|SV* sv @@ -935,6 +935,7 @@ Ap |DIR* |dirp_dup |DIR* dp Ap |GP* |gp_dup |GP* gp|CLONE_PARAMS* param Ap |MAGIC* |mg_dup |MAGIC* mg|CLONE_PARAMS* param Ap |SV* |sv_dup |SV* sstr|CLONE_PARAMS* param +Ap |void |rvpv_dup |SV* dstr|SV *sstr|CLONE_PARAMS* param #if defined(HAVE_INTERP_INTERN) Ap |void |sys_intern_dup |struct interp_intern* src \ |struct interp_intern* dst @@ -1000,11 +1001,11 @@ s |int |magic_methcall |SV *sv|const MAGIC *mg|const char *meth|I32 f \ #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) -s |I32 |list_assignment|OP *o -s |void |bad_type |I32 n|const char *t|const char *name|OP *kid +s |I32 |list_assignment|const OP *o +s |void |bad_type |I32 n|const char *t|const char *name|const OP *kid s |void |cop_free |COP *cop s |OP* |modkids |OP *o|I32 type -s |void |no_bareword_allowed|OP *o +s |void |no_bareword_allowed|const OP *o s |OP* |no_fh_allowed |OP *o s |OP* |scalarboolean |OP *o s |OP* |too_few_arguments|OP *o|const char* name @@ -1012,9 +1013,9 @@ s |OP* |too_many_arguments|OP *o|const char* name s |OP* |newDEFSVOP s |OP* |new_logop |I32 type|I32 flags|OP **firstp|OP **otherp s |void |simplify_sort |OP *o -s |bool |is_handle_constructor |OP *o|I32 argnum +s |bool |is_handle_constructor |const OP *o|I32 argnum s |char* |gv_ename |GV *gv -s |bool |scalar_mod_type|OP *o|I32 type +s |bool |scalar_mod_type|const OP *o|I32 type s |OP * |my_kid |OP *o|OP *attrs|OP **imopsp s |OP * |dup_attrlist |OP *o s |void |apply_attrs |HV *stash|SV *target|OP *attrs|bool for_my diff --git a/embed.h b/embed.h index 5c60394..57deaf0 100644 --- a/embed.h +++ b/embed.h @@ -1218,6 +1218,7 @@ #define gp_dup Perl_gp_dup #define mg_dup Perl_mg_dup #define sv_dup Perl_sv_dup +#define rvpv_dup Perl_rvpv_dup #if defined(HAVE_INTERP_INTERN) #define sys_intern_dup Perl_sys_intern_dup #endif @@ -3818,6 +3819,7 @@ #define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b) #define mg_dup(a,b) Perl_mg_dup(aTHX_ a,b) #define sv_dup(a,b) Perl_sv_dup(aTHX_ a,b) +#define rvpv_dup(a,b,c) Perl_rvpv_dup(aTHX_ a,b,c) #if defined(HAVE_INTERP_INTERN) #define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b) #endif diff --git a/global.sym b/global.sym index aa2ed48..3624874 100644 --- a/global.sym +++ b/global.sym @@ -617,6 +617,7 @@ Perl_dirp_dup Perl_gp_dup Perl_mg_dup Perl_sv_dup +Perl_rvpv_dup Perl_sys_intern_dup Perl_ptr_table_new Perl_ptr_table_fetch diff --git a/mg.c b/mg.c index b1830b1..f56812e 100644 --- a/mg.c +++ b/mg.c @@ -2489,7 +2489,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) { union pstun un; s = SvPV(sv, len); - un.pst_command = s; + un.pst_command = (char *)s; pstat(PSTAT_SETCMD, un, len, 0, 0); } #endif diff --git a/op.c b/op.c index 54d4c01..8421638 100644 --- a/op.c +++ b/op.c @@ -190,14 +190,14 @@ S_too_many_arguments(pTHX_ OP *o, const char *name) } STATIC void -S_bad_type(pTHX_ I32 n, const char *t, const char *name, OP *kid) +S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) { yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)", (int)n, name, t, OP_DESC(kid))); } STATIC void -S_no_bareword_allowed(pTHX_ OP *o) +S_no_bareword_allowed(pTHX_ const OP *o) { qerror(Perl_mess(aTHX_ "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use", @@ -270,7 +270,6 @@ Perl_allocmy(pTHX_ char *name) void Perl_op_free(pTHX_ OP *o) { - register OP *kid, *nextkid; OPCODE type; PADOFFSET refcnt; @@ -297,6 +296,7 @@ Perl_op_free(pTHX_ OP *o) } if (o->op_flags & OPf_KIDS) { + register OP *kid, *nextkid; for (kid = cUNOPo->op_first; kid; kid = nextkid) { nextkid = kid->op_sibling; /* Get before next freeing kid */ op_free(kid); @@ -494,13 +494,13 @@ Perl_op_refcnt_unlock(pTHX) OP * Perl_linklist(pTHX_ OP *o) { - register OP *kid; if (o->op_next) return o->op_next; /* establish postfix order */ if (cUNOPo->op_first) { + register OP *kid; o->op_next = LINKLIST(cUNOPo->op_first); for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) @@ -531,7 +531,7 @@ S_scalarboolean(pTHX_ OP *o) { if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { if (ckWARN(WARN_SYNTAX)) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); @@ -843,8 +843,8 @@ Perl_scalarvoid(pTHX_ OP *o) OP * Perl_listkids(pTHX_ OP *o) { - OP *kid; if (o && o->op_flags & OPf_KIDS) { + OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) list(kid); } @@ -929,14 +929,13 @@ Perl_list(pTHX_ OP *o) OP * Perl_scalarseq(pTHX_ OP *o) { - OP *kid; - if (o) { if (o->op_type == OP_LINESEQ || o->op_type == OP_SCOPE || o->op_type == OP_LEAVE || o->op_type == OP_LEAVETRY) { + OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) { scalarvoid(kid); @@ -956,8 +955,8 @@ Perl_scalarseq(pTHX_ OP *o) STATIC OP * S_modkids(pTHX_ OP *o, I32 type) { - OP *kid; if (o && o->op_flags & OPf_KIDS) { + OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) mod(kid, type); } @@ -1317,7 +1316,7 @@ Perl_mod(pTHX_ OP *o, I32 type) } STATIC bool -S_scalar_mod_type(pTHX_ OP *o, I32 type) +S_scalar_mod_type(pTHX_ const OP *o, I32 type) { switch (type) { case OP_SASSIGN: @@ -1364,7 +1363,7 @@ S_scalar_mod_type(pTHX_ OP *o, I32 type) } STATIC bool -S_is_handle_constructor(pTHX_ OP *o, I32 argnum) +S_is_handle_constructor(pTHX_ const OP *o, I32 argnum) { switch (o->op_type) { case OP_PIPE_OP: @@ -1389,8 +1388,8 @@ S_is_handle_constructor(pTHX_ OP *o, I32 argnum) OP * Perl_refkids(pTHX_ OP *o, I32 type) { - OP *kid; if (o && o->op_flags & OPf_KIDS) { + OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) ref(kid, type); } @@ -1617,8 +1616,8 @@ to respect attribute syntax properly would be welcome. */ void -Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, - char *attrstr, STRLEN len) +Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv, + const char *attrstr, STRLEN len) { OP *attrs = Nullop; @@ -1629,7 +1628,7 @@ Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, while (len) { for (; isSPACE(*attrstr) && len; --len, ++attrstr) ; if (len) { - char *sstr = attrstr; + const char *sstr = attrstr; for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ; attrs = append_elem(OP_LIST, attrs, newSVOP(OP_CONST, 0, @@ -1650,7 +1649,6 @@ Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) { - OP *kid; I32 type; if (!o || PL_error_count) @@ -1658,6 +1656,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) type = o->op_type; if (type == OP_LIST) { + OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) my_kid(kid, attrs, imopsp); } else if (type == OP_UNDEF) { @@ -1871,7 +1870,7 @@ Perl_block_start(pTHX_ int full) OP* Perl_block_end(pTHX_ I32 floor, OP *seq) { - int needblockscope = PL_hints & HINT_BLOCK_SCOPE; + const int needblockscope = PL_hints & HINT_BLOCK_SCOPE; OP* retval = scalarseq(seq); LEAVE_SCOPE(floor); PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); @@ -1884,7 +1883,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) STATIC OP * S_newDEFSVOP(pTHX) { - I32 offset = pad_findmy("$_"); + const I32 offset = pad_findmy("$_"); if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) { return newSVREF(newGVOP(OP_GV, 0, PL_defgv)); } @@ -2086,7 +2085,7 @@ OP * Perl_gen_constant_list(pTHX_ register OP *o) { register OP *curop; - I32 oldtmps_floor = PL_tmps_floor; + const I32 oldtmps_floor = PL_tmps_floor; list(o); if (PL_error_count) @@ -2956,7 +2955,7 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv) void Perl_package(pTHX_ OP *o) { - char *name; + const char *name; STRLEN len; save_hptr(&PL_curstash); @@ -3134,9 +3133,9 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) } } { - line_t ocopline = PL_copline; - COP *ocurcop = PL_curcop; - int oexpect = PL_expect; + const line_t ocopline = PL_copline; + COP * const ocurcop = PL_curcop; + const int oexpect = PL_expect; utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), veop, modname, imop); @@ -3178,7 +3177,7 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval) } STATIC I32 -S_list_assignment(pTHX_ register OP *o) +S_list_assignment(pTHX_ register const OP *o) { if (!o) return TRUE; @@ -3187,8 +3186,8 @@ S_list_assignment(pTHX_ register OP *o) o = cUNOPo->op_first; if (o->op_type == OP_COND_EXPR) { - I32 t = list_assignment(cLOGOPo->op_first->op_sibling); - I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling); + const I32 t = list_assignment(cLOGOPo->op_first->op_sibling); + const I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling); if (t && f) return TRUE; @@ -3502,7 +3501,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } else { /* check for C, or C */ - OP *o2 = other; + const OP *o2 = other; if ( ! (o2->op_type == OP_LIST && (( o2 = cUNOPx(o2)->op_first)) && o2->op_type == OP_PUSHMARK @@ -3528,8 +3527,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) && type != OP_DOR) /* [#24076] Don't warn for err FOO. */ { - OP *k1 = ((UNOP*)first)->op_first; - OP *k2 = k1->op_sibling; + const OP *k1 = ((UNOP*)first)->op_first; + const OP *k2 = k1->op_sibling; OPCODE warnop = 0; switch (first->op_type) { @@ -3554,7 +3553,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) break; } if (warnop) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ packWARN(WARN_MISC), "Value of %s%s can be \"0\"; test with defined()", @@ -4101,7 +4100,7 @@ Perl_cv_const_sv(pTHX_ CV *cv) */ SV * -Perl_op_const_sv(pTHX_ OP *o, CV *cv) +Perl_op_const_sv(pTHX_ const OP *o, CV *cv) { SV *sv = Nullsv; @@ -4181,8 +4180,8 @@ CV * Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) { STRLEN n_a; - char *name; - char *aname; + const char *name; + const char *aname; GV *gv; char *ps; register CV *cv=0; @@ -4255,7 +4254,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) const_sv = op_const_sv(block, Nullcv); if (cv) { - bool exists = CvROOT(cv) || CvXSUB(cv); + const bool exists = CvROOT(cv) || CvXSUB(cv); #ifdef GV_UNIQUE_CHECK if (exists && GvUNIQUE(gv)) { @@ -4288,7 +4287,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) || (CvCONST(cv) && (!const_sv || sv_cmp(cv_const_sv(cv), const_sv)))) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), @@ -4391,7 +4390,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) op_free(block); block = Nullop; if (name) { - char *s = strrchr(name, ':'); + const char *s = strrchr(name, ':'); s = s ? s+1 : name; if (strEQ(s, "BEGIN")) { const char not_safe[] = @@ -4438,8 +4437,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } if (name || aname) { - char *s; - char *tname = (name ? name : aname); + const char *s; + const char *tname = (name ? name : aname); if (PERLDB_SUBLINE && PL_curstash != PL_debstash) { SV *sv = NEWSV(0,0); @@ -4474,7 +4473,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) goto done; if (strEQ(s, "BEGIN") && !PL_error_count) { - I32 oldscope = PL_scopestack_ix; + const I32 oldscope = PL_scopestack_ix; ENTER; SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); @@ -4597,7 +4596,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) /* already defined (or promised) */ if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv)) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), @@ -4695,7 +4694,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) GvMULTI_on(gv); if ((cv = GvFORM(gv))) { if (ckWARN(WARN_REDEFINE)) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), @@ -4901,8 +4900,8 @@ Perl_ck_bitop(pTHX_ OP *o) || o->op_type == OP_BIT_AND || o->op_type == OP_BIT_XOR)) { - OP * left = cBINOPo->op_first; - OP * right = left->op_sibling; + const OP * left = cBINOPo->op_first; + const OP * right = left->op_sibling; if ((OP_IS_NUMCOMPARE(left->op_type) && (left->op_flags & OPf_PARENS) == 0) || (OP_IS_NUMCOMPARE(right->op_type) && @@ -4920,7 +4919,7 @@ Perl_ck_bitop(pTHX_ OP *o) OP * Perl_ck_concat(pTHX_ OP *o) { - OP *kid = cUNOPo->op_first; + const OP *kid = cUNOPo->op_first; if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) && !(kUNOP->op_first->op_flags & OPf_MOD)) o->op_flags |= OPf_STACKED; @@ -4933,7 +4932,7 @@ Perl_ck_spair(pTHX_ OP *o) if (o->op_flags & OPf_KIDS) { OP* newop; OP* kid; - OPCODE type = o->op_type; + const OPCODE type = o->op_type; o = modkids(ck_fun(o), type); kid = cUNOPo->op_first; newop = kUNOP->op_first->op_sibling; @@ -4992,7 +4991,7 @@ Perl_ck_die(pTHX_ OP *o) OP * Perl_ck_eof(pTHX_ OP *o) { - I32 type = o->op_type; + const I32 type = o->op_type; if (o->op_flags & OPf_KIDS) { if (cLISTOPo->op_first->op_type == OP_STUB) { @@ -5066,8 +5065,8 @@ Perl_ck_exit(pTHX_ OP *o) OP * Perl_ck_exec(pTHX_ OP *o) { - OP *kid; if (o->op_flags & OPf_STACKED) { + OP *kid; o = ck_fun(o); kid = cUNOPo->op_first->op_sibling; if (kid->op_type == OP_RV2GV) @@ -5213,7 +5212,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) OP * Perl_ck_ftst(pTHX_ OP *o) { - I32 type = o->op_type; + const I32 type = o->op_type; if (o->op_flags & OPf_REF) { /* nothing */ @@ -5250,11 +5249,7 @@ Perl_ck_ftst(pTHX_ OP *o) OP * Perl_ck_fun(pTHX_ OP *o) { - register OP *kid; - OP **tokid; - OP *sibl; - I32 numargs = 0; - int type = o->op_type; + const int type = o->op_type; register I32 oa = PL_opargs[type] >> OASHIFT; if (o->op_flags & OPf_STACKED) { @@ -5265,8 +5260,11 @@ Perl_ck_fun(pTHX_ OP *o) } if (o->op_flags & OPf_KIDS) { - tokid = &cLISTOPo->op_first; - kid = cLISTOPo->op_first; + OP **tokid = &cLISTOPo->op_first; + register OP *kid = cLISTOPo->op_first; + OP *sibl; + I32 numargs = 0; + if (kid->op_type == OP_PUSHMARK || (kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)) { @@ -5428,7 +5426,7 @@ Perl_ck_fun(pTHX_ OP *o) else if (op->op_type == OP_PADAV || op->op_type == OP_PADHV) { /* lexicalvar $a[] or $h{} */ - char *padname = + const char *padname = PAD_COMPNAME_PV(op->op_targ); if (padname) tmpstr = @@ -5555,7 +5553,7 @@ Perl_ck_grep(pTHX_ OP *o) { LOGOP *gwop; OP *kid; - OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; + const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; I32 offset; o->op_ppaddr = PL_ppaddr[OP_GREPSTART]; @@ -5632,7 +5630,7 @@ Perl_ck_lengthconst(pTHX_ OP *o) OP * Perl_ck_lfun(pTHX_ OP *o) { - OPCODE type = o->op_type; + const OPCODE type = o->op_type; return modkids(ck_fun(o), type); } @@ -5677,7 +5675,7 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ OP * Perl_ck_rfun(pTHX_ OP *o) { - OPCODE type = o->op_type; + const OPCODE type = o->op_type; return refkids(ck_fun(o), type); } @@ -5758,7 +5756,7 @@ OP * Perl_ck_match(pTHX_ OP *o) { if (o->op_type != OP_QR) { - I32 offset = pad_findmy("$_"); + const I32 offset = pad_findmy("$_"); if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) { o->op_targ = offset; o->op_private |= OPpTARGET_MY; @@ -5907,8 +5905,8 @@ Perl_ck_require(pTHX_ OP *o) OP * Perl_ck_return(pTHX_ OP *o) { - OP *kid; if (CvLVALUE(PL_compcv)) { + OP *kid; for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling) mod(kid, OP_LEAVESUBLV); } @@ -5948,7 +5946,7 @@ Perl_ck_select(pTHX_ OP *o) OP * Perl_ck_shift(pTHX_ OP *o) { - I32 type = o->op_type; + const I32 type = o->op_type; if (!(o->op_flags & OPf_KIDS)) { OP *argop; @@ -6152,11 +6150,10 @@ OP * Perl_ck_join(pTHX_ OP *o) { if (ckWARN(WARN_SYNTAX)) { - OP *kid = cLISTOPo->op_first->op_sibling; + const OP *kid = cLISTOPo->op_first->op_sibling; if (kid && kid->op_type == OP_MATCH) { - const char *pmstr = "STRING"; - if (PM_GETRE(kPMOP)) - pmstr = PM_GETRE(kPMOP)->precomp; + const REGEXP *re = PM_GETRE(kPMOP); + const char *pmstr = re ? re->precomp : "STRING"; Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "/%s/ should probably be written as \"%s\"", pmstr, pmstr); @@ -6309,8 +6306,8 @@ Perl_ck_subr(pTHX_ OP *o) break; case ']': if (contextclass) { - char *p = proto; - char s = *p; + char *p = proto; + const char s = *p; contextclass = 0; *p = '\0'; while (*--p != '['); @@ -6488,7 +6485,7 @@ Perl_peep(pTHX_ register OP *o) * Despite being a "constant", the SV is written to, * for reference counts, sv_upgrade() etc. */ if (cSVOP->op_sv) { - PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP); + const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP); if (o->op_type == OP_CONST && SvPADTMP(cSVOPo->op_sv)) { /* If op_sv is already a PADTMP then it is being used by * some pad, so make a copy. */ @@ -6683,7 +6680,7 @@ Perl_peep(pTHX_ register OP *o) o->op_next->op_sibling->op_type != OP_EXIT && o->op_next->op_sibling->op_type != OP_WARN && o->op_next->op_sibling->op_type != OP_DIE) { - line_t oldline = CopLINE(PL_curcop); + const line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next)); Perl_warner(aTHX_ packWARN(WARN_EXEC), diff --git a/perl.c b/perl.c index 806ba39..9c859a4 100644 --- a/perl.c +++ b/perl.c @@ -3838,6 +3838,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[]) int euid = PerlProc_geteuid(); int gid = PerlProc_getgid(); int egid = PerlProc_getegid(); + (void)envp; #ifdef VMS uid |= gid << 16; @@ -3853,7 +3854,6 @@ Perl_doing_taint(int argc, char *argv[], char *envp[]) && (argv[1][1] == 't' || argv[1][1] == 'T') ) return 1; return 0; - (void)envp; } STATIC void diff --git a/proto.h b/proto.h index 8cf2ed9..627b25e 100644 --- a/proto.h +++ b/proto.h @@ -56,7 +56,7 @@ PERL_CALLCONV CV* Perl_gv_handler(pTHX_ HV* stash, I32 id); PERL_CALLCONV OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail); 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_ char *stashpv, CV *cv, char *attrstr, STRLEN len); +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); @@ -126,7 +126,7 @@ PERL_CALLCONV int Perl_printf_nocontext(const char* fmt, ...) PERL_CALLCONV void Perl_cv_ckproto(pTHX_ const CV* cv, const GV* gv, const char* p); PERL_CALLCONV CV* Perl_cv_clone(pTHX_ CV* proto); PERL_CALLCONV SV* Perl_cv_const_sv(pTHX_ CV* cv); -PERL_CALLCONV SV* Perl_op_const_sv(pTHX_ OP* o, CV* cv); +PERL_CALLCONV SV* Perl_op_const_sv(pTHX_ const OP* o, CV* cv); PERL_CALLCONV void Perl_cv_undef(pTHX_ CV* cv); PERL_CALLCONV void Perl_cx_dump(pTHX_ PERL_CONTEXT* cs); PERL_CALLCONV SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv); @@ -142,7 +142,7 @@ PERL_CALLCONV void Perl_deb(pTHX_ const char* pat, ...) __attribute__format__(__printf__,pTHX_1,pTHX_2); PERL_CALLCONV void Perl_vdeb(pTHX_ const char* pat, va_list* args); PERL_CALLCONV void Perl_debprofdump(pTHX); -PERL_CALLCONV I32 Perl_debop(pTHX_ OP* o); +PERL_CALLCONV I32 Perl_debop(pTHX_ const OP* o); PERL_CALLCONV I32 Perl_debstack(pTHX); PERL_CALLCONV I32 Perl_debstackptrs(pTHX); PERL_CALLCONV char* Perl_delimcpy(pTHX_ char* to, const char* toend, const char* from, const char* fromend, int delim, I32* retlen); @@ -203,7 +203,7 @@ PERL_CALLCONV void Perl_dump_fds(pTHX_ char* s); #endif PERL_CALLCONV void Perl_dump_form(pTHX_ const GV* gv); PERL_CALLCONV void Perl_gv_dump(pTHX_ GV* gv); -PERL_CALLCONV void Perl_op_dump(pTHX_ OP* arg); +PERL_CALLCONV void Perl_op_dump(pTHX_ const OP* arg); PERL_CALLCONV void Perl_pmop_dump(pTHX_ PMOP* pm); PERL_CALLCONV void Perl_dump_packsubs(pTHX_ const HV* stash); PERL_CALLCONV void Perl_dump_sub(pTHX_ const GV* gv); @@ -858,11 +858,11 @@ PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* PERL_CALLCONV void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv); PERL_CALLCONV void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv); PERL_CALLCONV void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv); -PERL_CALLCONV void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); -PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); -PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm); +PERL_CALLCONV void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); +PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o); +PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm); PERL_CALLCONV void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); -PERL_CALLCONV void Perl_magic_dump(pTHX_ MAGIC *mg); +PERL_CALLCONV void Perl_magic_dump(pTHX_ const MAGIC *mg); PERL_CALLCONV void Perl_reginitcolors(pTHX); PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv); PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv); @@ -896,6 +896,7 @@ PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp); PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, CLONE_PARAMS* param); PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg, CLONE_PARAMS* param); PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr, CLONE_PARAMS* param); +PERL_CALLCONV void Perl_rvpv_dup(pTHX_ SV* dstr, SV *sstr, CLONE_PARAMS* param); #if defined(HAVE_INTERP_INTERN) PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst); #endif @@ -959,11 +960,11 @@ STATIC int S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 #endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) -STATIC I32 S_list_assignment(pTHX_ OP *o); -STATIC void S_bad_type(pTHX_ I32 n, const char *t, const char *name, OP *kid); +STATIC I32 S_list_assignment(pTHX_ const OP *o); +STATIC void S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid); STATIC void S_cop_free(pTHX_ COP *cop); STATIC OP* S_modkids(pTHX_ OP *o, I32 type); -STATIC void S_no_bareword_allowed(pTHX_ OP *o); +STATIC void S_no_bareword_allowed(pTHX_ const OP *o); STATIC OP* S_no_fh_allowed(pTHX_ OP *o); STATIC OP* S_scalarboolean(pTHX_ OP *o); STATIC OP* S_too_few_arguments(pTHX_ OP *o, const char* name); @@ -971,9 +972,9 @@ STATIC OP* S_too_many_arguments(pTHX_ OP *o, const char* name); STATIC OP* S_newDEFSVOP(pTHX); STATIC OP* S_new_logop(pTHX_ I32 type, I32 flags, OP **firstp, OP **otherp); STATIC void S_simplify_sort(pTHX_ OP *o); -STATIC bool S_is_handle_constructor(pTHX_ OP *o, I32 argnum); +STATIC bool S_is_handle_constructor(pTHX_ const OP *o, I32 argnum); STATIC char* S_gv_ename(pTHX_ GV *gv); -STATIC bool S_scalar_mod_type(pTHX_ OP *o, I32 type); +STATIC bool S_scalar_mod_type(pTHX_ const OP *o, I32 type); STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp); STATIC OP * S_dup_attrlist(pTHX_ OP *o); STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my); diff --git a/sv.c b/sv.c index 73aed10..97e76d2 100644 --- a/sv.c +++ b/sv.c @@ -7228,7 +7228,7 @@ thats_really_all_folks: screamer2: if (rslen) { - register STDCHAR *bpe = buf + sizeof(buf); + const register STDCHAR *bpe = buf + sizeof(buf); bp = buf; while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe) ; /* keep reading */ diff --git a/universal.c b/universal.c index adff0ff..149355f 100644 --- a/universal.c +++ b/universal.c @@ -249,8 +249,9 @@ XS(XS_UNIVERSAL_isa) { dXSARGS; SV *sv; - char *name; + const char *name; STRLEN n_a; + (void)cv; if (items != 2) Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)"); @@ -264,7 +265,7 @@ XS(XS_UNIVERSAL_isa) || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) XSRETURN_UNDEF; - name = (char *)SvPV(ST(1),n_a); + name = (const char *)SvPV(ST(1),n_a); ST(0) = boolSV(sv_derived_from(sv, name)); XSRETURN(1); @@ -274,10 +275,11 @@ XS(XS_UNIVERSAL_can) { dXSARGS; SV *sv; - char *name; + const char *name; SV *rv; HV *pkg = NULL; STRLEN n_a; + (void)cv; if (items != 2) Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)"); @@ -291,7 +293,7 @@ XS(XS_UNIVERSAL_can) || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) XSRETURN_UNDEF; - name = (char *)SvPV(ST(1),n_a); + name = (const char *)SvPV(ST(1),n_a); rv = &PL_sv_undef; if (SvROK(sv)) { @@ -321,6 +323,7 @@ XS(XS_UNIVERSAL_VERSION) GV *gv; SV *sv; const char *undef; + (void)cv; if (SvROK(ST(0))) { sv = (SV*)SvRV(ST(0)); @@ -390,6 +393,7 @@ XS(XS_UNIVERSAL_VERSION) XS(XS_version_new) { dXSARGS; + (void)cv; if (items > 3) Perl_croak(aTHX_ "Usage: version::new(class, version)"); SP -= items; @@ -416,6 +420,7 @@ XS(XS_version_new) XS(XS_version_stringify) { dXSARGS; + (void)cv; if (items < 1) Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)"); SP -= items; @@ -439,6 +444,7 @@ XS(XS_version_stringify) XS(XS_version_numify) { dXSARGS; + (void)cv; if (items < 1) Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)"); SP -= items; @@ -462,6 +468,7 @@ XS(XS_version_numify) XS(XS_version_vcmp) { dXSARGS; + (void)cv; if (items < 1) Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)"); SP -= items; @@ -507,6 +514,7 @@ XS(XS_version_vcmp) XS(XS_version_boolean) { dXSARGS; + (void)cv; if (items < 1) Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)"); SP -= items; @@ -514,6 +522,7 @@ XS(XS_version_boolean) SV * lobj; if (sv_derived_from(ST(0), "version")) { + /* XXX If tmp serves a purpose, explain it. */ SV *tmp = SvRV(ST(0)); lobj = tmp; } @@ -534,6 +543,7 @@ XS(XS_version_boolean) XS(XS_version_noop) { dXSARGS; + (void)cv; if (items < 1) Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)"); { @@ -557,6 +567,7 @@ XS(XS_version_noop) XS(XS_version_is_alpha) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)"); SP -= items; @@ -564,14 +575,15 @@ XS(XS_version_is_alpha) SV *lobj; if (sv_derived_from(ST(0), "version")) { + /* XXX If tmp serves a purpose, explain it. */ SV *tmp = SvRV(ST(0)); lobj = tmp; } else Perl_croak(aTHX_ "lobj is not of type version"); { - I32 len = av_len((AV *)lobj); - I32 digit = SvIVX(*av_fetch((AV *)lobj, len, 0)); + const I32 len = av_len((AV *)lobj); + const I32 digit = SvIVX(*av_fetch((AV *)lobj, len, 0)); if ( digit < 0 ) XSRETURN_YES; else @@ -585,6 +597,7 @@ XS(XS_version_is_alpha) XS(XS_version_qv) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: version::qv(ver)"); SP -= items; @@ -622,10 +635,11 @@ XS(XS_version_qv) XS(XS_utf8_is_utf8) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)"); { - SV * sv = ST(0); + const SV *sv = ST(0); { if (SvUTF8(sv)) XSRETURN_YES; @@ -639,14 +653,15 @@ XS(XS_utf8_is_utf8) XS(XS_utf8_valid) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::valid(sv)"); { SV * sv = ST(0); { STRLEN len; - char *s = SvPV(sv,len); - if (!SvUTF8(sv) || is_utf8_string((U8*)s,len)) + const char *s = SvPV(sv,len); + if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len)) XSRETURN_YES; else XSRETURN_NO; @@ -658,6 +673,7 @@ XS(XS_utf8_valid) XS(XS_utf8_encode) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::encode(sv)"); { @@ -671,13 +687,12 @@ XS(XS_utf8_encode) XS(XS_utf8_decode) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::decode(sv)"); { SV * sv = ST(0); - bool RETVAL; - - RETVAL = sv_utf8_decode(sv); + const bool RETVAL = sv_utf8_decode(sv); ST(0) = boolSV(RETVAL); sv_2mortal(ST(0)); } @@ -687,6 +702,7 @@ XS(XS_utf8_decode) XS(XS_utf8_upgrade) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)"); { @@ -703,20 +719,14 @@ XS(XS_utf8_upgrade) XS(XS_utf8_downgrade) { dXSARGS; + (void)cv; if (items < 1 || items > 2) Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)"); { SV * sv = ST(0); - bool failok; - bool RETVAL; - - if (items < 2) - failok = 0; - else { - failok = (int)SvIV(ST(1)); - } + const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1)); + const bool RETVAL = sv_utf8_downgrade(sv, failok); - RETVAL = sv_utf8_downgrade(sv, failok); ST(0) = boolSV(RETVAL); sv_2mortal(ST(0)); } @@ -726,7 +736,8 @@ XS(XS_utf8_downgrade) XS(XS_utf8_native_to_unicode) { dXSARGS; - UV uv = SvUV(ST(0)); + const UV uv = SvUV(ST(0)); + (void)cv; if (items > 1) Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)"); @@ -738,7 +749,8 @@ XS(XS_utf8_native_to_unicode) XS(XS_utf8_unicode_to_native) { dXSARGS; - UV uv = SvUV(ST(0)); + const UV uv = SvUV(ST(0)); + (void)cv; if (items > 1) Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)"); @@ -751,6 +763,8 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ { dXSARGS; SV *sv = SvRV(ST(0)); + (void)cv; + if (items == 1) { if (SvREADONLY(sv)) XSRETURN_YES; @@ -775,6 +789,8 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ { dXSARGS; SV *sv = SvRV(ST(0)); + (void)cv; + if (items == 1) XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */ else if (items == 2) { @@ -789,6 +805,8 @@ XS(XS_Internals_hv_clear_placehold) { dXSARGS; HV *hv = (HV *) SvRV(ST(0)); + (void)cv; + if (items != 1) Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)"); hv_clear_placeholders(hv); @@ -797,12 +815,13 @@ XS(XS_Internals_hv_clear_placehold) XS(XS_Regexp_DESTROY) { - + (void)cv; } XS(XS_PerlIO_get_layers) { dXSARGS; + (void)cv; if (items < 1 || items % 2 == 0) Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])"); #ifdef USE_PERLIO @@ -820,7 +839,7 @@ XS(XS_PerlIO_get_layers) SV **varp = svp; SV **valp = svp + 1; STRLEN klen; - char *key = SvPV(*varp, klen); + const char *key = SvPV(*varp, klen); switch (*key) { case 'i': @@ -930,6 +949,7 @@ XS(XS_Internals_hash_seed) /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dMARK; dAX; + (void)cv; XSRETURN_UV(PERL_HASH_SEED); } @@ -938,14 +958,16 @@ XS(XS_Internals_rehash_seed) /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dMARK; dAX; + (void)cv; XSRETURN_UV(PL_rehash_seed); } XS(XS_Internals_HvREHASH) /* Subject to change */ { dXSARGS; + (void)cv; if (SvROK(ST(0))) { - HV *hv = (HV *) SvRV(ST(0)); + const HV *hv = (HV *) SvRV(ST(0)); if (items == 1 && SvTYPE(hv) == SVt_PVHV) { if (HvREHASH(hv)) XSRETURN_YES; diff --git a/xsutils.c b/xsutils.c index a20b0d2..a8a95e2 100644 --- a/xsutils.c +++ b/xsutils.c @@ -160,6 +160,7 @@ XS(XS_attributes_bootstrap) { dXSARGS; const char file[] = __FILE__; + (void)cv; if( items > 1 ) Perl_croak(aTHX_ "Usage: attributes::bootstrap $module"); @@ -177,6 +178,7 @@ XS(XS_attributes__modify_attrs) { dXSARGS; SV *rv, *sv; + (void)cv; if (items < 1) { usage: @@ -199,6 +201,7 @@ XS(XS_attributes__fetch_attrs) dXSARGS; SV *rv, *sv; cv_flags_t cvflags; + (void)cv; if (items != 1) { usage: @@ -244,6 +247,7 @@ XS(XS_attributes__guess_stash) dXSARGS; SV *rv, *sv; dXSTARG; + (void)cv; if (items != 1) { usage: @@ -264,7 +268,7 @@ usage: sv_setsv(TARG, &PL_sv_no); /* unblessed lexical */ #endif else { - HV *stash = Nullhv; + const HV *stash = Nullhv; switch (SvTYPE(sv)) { case SVt_PVCV: if (CvGV(sv) && isGV(CvGV(sv)) && GvSTASH(CvGV(sv))) @@ -296,6 +300,7 @@ XS(XS_attributes_reftype) dXSARGS; SV *rv, *sv; dXSTARG; + (void)cv; if (items != 1) { usage: @@ -319,6 +324,7 @@ usage: XS(XS_attributes__warn_reserved) { dXSARGS; + (void)cv; if (items != 0) { Perl_croak(aTHX_