From c501bbfe1b05f03fd21cc2fb644a5ff26a3f1091 Mon Sep 17 00:00:00 2001 From: Andy Lester Date: Wed, 30 Mar 2005 05:40:24 -0600 Subject: [PATCH] Integrate: [ 24148] Subject: [PATCH] const-eight.diff Message-ID: <20050330174024.GA12167@petdance.com> [ 24178] Don't try to export symbols that don't exist Change #24148 added Perl_rvpv_dup() to the public API, but it is only defined when USE_ITHREADS is defined. Adjust makedef.pl accordingly to keep Win32 happy. p4raw-link: @24178 on //depot/perl: aeef272316a199aeddb8b9a9713adffbef5806b1 p4raw-link: @24148 on //depot/perl: 6867be6d47d7be8fc56705e4b65f064d3eef92b7 p4raw-id: //depot/maint-5.8/perl@25438 p4raw-integrated: from //depot/perl@24178 'merge in' makedef.pl (@23780..) p4raw-integrated: from //depot/perl@24148 'edit in' universal.c (@24074..) op.c (@24096..) dump.c (@24106..) 'merge in' xsutils.c (@24074..) doio.c (@24092..) perl.c (@24094..) embed.fnc (@24095..) mg.c (@24096..) sv.c (@24109..) embed.h global.sym proto.h (@24121..) Porting/Maintainers.pl (@24133..) --- Porting/Maintainers.pl | 2 +- doio.c | 49 +++++++++++--------- dump.c | 5 +- embed.fnc | 11 +++-- embed.h | 2 + global.sym | 1 + makedef.pl | 1 + mg.c | 2 +- op.c | 123 ++++++++++++++++++++++++------------------------- perl.c | 2 +- proto.h | 11 +++-- sv.c | 2 +- universal.c | 60 ++++++++++++++---------- xsutils.c | 8 +++- 14 files changed, 151 insertions(+), 128 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9c7d2e2..b4e46bf 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -42,7 +42,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 6e362e5..50eb4ff 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) { @@ -1602,7 +1603,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; @@ -1640,12 +1641,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); } @@ -1661,7 +1661,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; @@ -1704,6 +1703,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(); @@ -1956,12 +1956,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) { @@ -1990,12 +1989,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); @@ -2114,10 +2114,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); @@ -2137,10 +2138,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)) @@ -2173,10 +2175,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 @@ -2187,7 +2189,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; @@ -2226,11 +2228,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 5d1bf9a..e0a7ed5 100644 --- a/dump.c +++ b/dump.c @@ -1460,7 +1460,6 @@ Perl_runops_debug(pTHX) I32 Perl_debop(pTHX_ OP *o) { - AV *padlist, *comppad; CV *cv; SV *sv; @@ -1489,8 +1488,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 ea9884c..2b18f9e 100644 --- a/embed.fnc +++ b/embed.fnc @@ -960,6 +960,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 @@ -1026,11 +1027,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 @@ -1038,9 +1039,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 78e14ba..bd2e20a 100644 --- a/embed.h +++ b/embed.h @@ -1016,6 +1016,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 @@ -3007,6 +3008,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 a5a2d8f..9021933 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/makedef.pl b/makedef.pl index 5408ab5..e2a5cb9 100644 --- a/makedef.pl +++ b/makedef.pl @@ -698,6 +698,7 @@ unless ($define{'USE_ITHREADS'}) { Perl_mg_dup Perl_re_dup Perl_sv_dup + Perl_rvpv_dup Perl_sys_intern_dup Perl_ptr_table_clear Perl_ptr_table_fetch diff --git a/mg.c b/mg.c index 7422abb..fc09641 100644 --- a/mg.c +++ b/mg.c @@ -2511,7 +2511,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 17bc8e1..7f904fb 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", @@ -336,7 +336,6 @@ Perl_find_threadsv(pTHX_ const char *name) void Perl_op_free(pTHX_ OP *o) { - register OP *kid, *nextkid; OPCODE type; PADOFFSET refcnt; @@ -363,6 +362,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); @@ -569,13 +569,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) @@ -606,7 +606,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); @@ -908,8 +908,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); } @@ -994,14 +994,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); @@ -1021,8 +1020,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); } @@ -1358,7 +1357,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: @@ -1405,7 +1404,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: @@ -1430,8 +1429,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); } @@ -1674,7 +1673,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, @@ -1695,7 +1694,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) @@ -1703,6 +1701,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) { @@ -1914,7 +1913,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); /* If there were syntax errors, don't try to close a block */ if (PL_yynerrs) return retval; @@ -2134,7 +2133,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) @@ -3167,9 +3166,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); @@ -3211,7 +3210,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; @@ -3220,8 +3219,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; @@ -3548,8 +3547,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } } else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) { - 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) { @@ -3574,7 +3573,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()", @@ -4188,8 +4187,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; STRLEN ps_len; @@ -4260,7 +4259,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)) { @@ -4293,7 +4292,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), @@ -4402,7 +4401,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[] = @@ -4449,8 +4448,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); @@ -4485,7 +4484,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) goto done; if (strEQ(s, "BEGIN")) { - I32 oldscope = PL_scopestack_ix; + const I32 oldscope = PL_scopestack_ix; ENTER; SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); @@ -4605,7 +4604,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, 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), @@ -4710,7 +4709,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), "Format %s redefined",name); @@ -4914,8 +4913,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) && @@ -4933,7 +4932,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; @@ -4946,7 +4945,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; @@ -5005,7 +5004,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) { @@ -5077,8 +5076,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) @@ -5236,7 +5235,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 */ @@ -5270,11 +5269,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) { @@ -5286,8 +5281,11 @@ Perl_ck_fun(pTHX_ OP *o) if (o->op_flags & OPf_KIDS) { STRLEN n_a; - 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)) { @@ -5456,7 +5454,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 = @@ -5583,7 +5581,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; o->op_ppaddr = PL_ppaddr[OP_GREPSTART]; NewOp(1101, gwop, 1, LOGOP); @@ -5654,7 +5652,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); } @@ -5699,7 +5697,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); } @@ -5921,8 +5919,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); } @@ -5962,7 +5960,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; @@ -6178,11 +6176,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); @@ -6319,8 +6316,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 != '['); @@ -6487,7 +6484,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. */ @@ -6679,7 +6676,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 7ec5638..acfd01a 100644 --- a/perl.c +++ b/perl.c @@ -3990,6 +3990,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; @@ -4005,7 +4006,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 10da93e..312c9f2 100644 --- a/proto.h +++ b/proto.h @@ -917,6 +917,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 @@ -981,11 +982,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); @@ -993,9 +994,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 fa950b9..a19c1b2 100644 --- a/sv.c +++ b/sv.c @@ -6413,7 +6413,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 921a34b..847de77 100644 --- a/universal.c +++ b/universal.c @@ -221,8 +221,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)"); @@ -236,7 +237,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); @@ -246,10 +247,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)"); @@ -263,7 +265,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)) { @@ -293,6 +295,7 @@ XS(XS_UNIVERSAL_VERSION) GV *gv; SV *sv; const char *undef; + (void)cv; if (SvROK(ST(0))) { sv = (SV*)SvRV(ST(0)); @@ -383,10 +386,11 @@ finish: 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; @@ -400,14 +404,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; @@ -419,6 +424,7 @@ XS(XS_utf8_valid) XS(XS_utf8_encode) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::encode(sv)"); { @@ -432,13 +438,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)); } @@ -448,6 +453,7 @@ XS(XS_utf8_decode) XS(XS_utf8_upgrade) { dXSARGS; + (void)cv; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)"); { @@ -464,20 +470,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)); } @@ -487,7 +487,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)"); @@ -499,7 +500,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)"); @@ -512,6 +514,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; @@ -536,6 +540,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) { @@ -550,6 +556,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); @@ -558,12 +566,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 @@ -581,7 +590,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': @@ -691,6 +700,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); } @@ -699,14 +709,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 06d0683..733f428 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: @@ -242,6 +245,7 @@ XS(XS_attributes__guess_stash) dXSARGS; SV *rv, *sv; dXSTARG; + (void)cv; if (items != 1) { usage: @@ -262,7 +266,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))) @@ -294,6 +298,7 @@ XS(XS_attributes_reftype) dXSARGS; SV *rv, *sv; dXSTARG; + (void)cv; if (items != 1) { usage: @@ -317,6 +322,7 @@ usage: XS(XS_attributes__warn_reserved) { dXSARGS; + (void)cv; if (items != 0) { Perl_croak(aTHX_ -- 1.8.3.1