This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
const-eight.diff
authorAndy Lester <andy@petdance.com>
Wed, 30 Mar 2005 11:40:24 +0000 (05:40 -0600)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 4 Apr 2005 14:19:30 +0000 (14:19 +0000)
Message-ID: <20050330174024.GA12167@petdance.com>

p4raw-id: //depot/perl@24148

13 files changed:
Porting/Maintainers.pl
doio.c
dump.c
embed.fnc
embed.h
global.sym
mg.c
op.c
perl.c
proto.h
sv.c
universal.c
xsutils.c

index 95a1598..d47dfa3 100644 (file)
@@ -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 db5e52a..e9effd9 100644 (file)
--- 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 (file)
--- 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;
index f861478..13cf0ae 100644 (file)
--- 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 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
index aa2ed48..3624874 100644 (file)
@@ -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 (file)
--- 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 (file)
--- 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 806ba39..9c859a4 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 */
index adff0ff..149355f 100644 (file)
@@ -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;
index a20b0d2..a8a95e2 100644 (file)
--- 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_