summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Porting/Maintainers.pl2
-rw-r--r--doio.c49
-rw-r--r--dump.c25
-rw-r--r--embed.fnc27
-rw-r--r--embed.h2
-rw-r--r--global.sym1
-rw-r--r--mg.c2
-rw-r--r--op.c137
-rw-r--r--perl.c2
-rw-r--r--proto.h27
-rw-r--r--sv.c2
-rw-r--r--universal.c74
-rw-r--r--xsutils.c8
13 files changed, 195 insertions, 163 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 95a1598ba7..d47dfa3f2f 100644
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -41,7 +41,7 @@ package Maintainers;
'ni-s' => 'Nick Ing-Simmons <nick@ing-simmons.net>',
'p5p' => 'perl5-porters <perl5-porters@perl.org>',
'perlfaq' => 'perlfaq-workers <perlfaq-workers@perl.org>',
- 'petdance' => 'Andy Lester <petdance@cpan.org>',
+ 'petdance' => 'Andy Lester <andy@petdance.com>',
'pmqs' => 'Paul Marquess <pmqs@cpan.org>',
'pvhp' => 'Peter Prymmer <pvhp@best.com>',
'rclamp' => 'Richard Clamp <rclamp@cpan.org>',
diff --git a/doio.c b/doio.c
index db5e52a3c8..e9effd95b6 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 6122ea73fe..31a0e038d7 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 f861478d86..13cf0ae3ea 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 5c60394283..57deaf092e 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 aa2ed48621..3624874ff8 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 b1830b1271..f56812e7c2 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 54d4c014b6..8421638e8c 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<my $x if 0>, or C<my($x,$y) if 0> */
- 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 <FH> 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 806ba39181..9c859a4d25 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 8cf2ed99b2..627b25e3db 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 73aed10c07..97e76d267a 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 adff0fff03..149355f8a4 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 a20b0d2658..a8a95e292d 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_
View Lorry Controller Status