This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More consting, and putting stuff in embed.fnc
authorAndy Lester <andy@petdance.com>
Mon, 5 Dec 2005 13:46:13 +0000 (07:46 -0600)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 6 Dec 2005 17:23:09 +0000 (17:23 +0000)
Message-ID: <20051205194613.GB7791@petdance.com>

p4raw-id: //depot/perl@26281

24 files changed:
deb.c
doio.c
dump.c
embed.fnc
embed.h
hv.c
hv.h
locale.c
mg.c
op.c
op.h
pp.c
pp_ctl.c
pp_hot.c
pp_pack.c
pp_sort.c
pp_sys.c
proto.h
regcomp.c
sv.c
taint.c
toke.c
utf8.c
util.c

diff --git a/deb.c b/deb.c
index 23c16dc..933ae6c 100644 (file)
--- a/deb.c
+++ b/deb.c
@@ -160,7 +160,7 @@ Perl_debstack(pTHX)
 
 
 #ifdef DEBUGGING
-static const char * si_names[] = {
+static const char * const si_names[] = {
     "UNKNOWN",
     "UNDEF",
     "MAIN",
@@ -182,7 +182,7 @@ void
 Perl_deb_stack_all(pTHX)
 {
 #ifdef DEBUGGING
-    I32                 ix, si_ix;
+    I32 si_ix;
     const PERL_SI *si;
 
     /* rewind to start of chain */
@@ -195,6 +195,7 @@ Perl_deb_stack_all(pTHX)
     {
         const int si_name_ix = si->si_type+1; /* -1 is a valid index */
         const char * const si_name = (si_name_ix>= sizeof(si_names)) ? "????" : si_names[si_name_ix];
+       I32 ix;
        PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n",
                                                (IV)si_ix, si_name);
 
diff --git a/doio.c b/doio.c
index e1ddfcb..69aa4c2 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1320,11 +1320,11 @@ Perl_my_stat(pTHX)
     }
 }
 
-static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
 
 I32
 Perl_my_lstat(pTHX)
 {
+    static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
     dSP;
     SV *sv;
     if (PL_op->op_flags & OPf_REF) {
diff --git a/dump.c b/dump.c
index 9dc7db8..16c7281 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -24,6 +24,8 @@
 #define PERL_IN_DUMP_C
 #include "perl.h"
 #include "regcomp.h"
+#include "proto.h"
+
 
 #define Sequence PL_op_sequence
 
@@ -402,7 +404,7 @@ 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 const OP *o)
+S_sequence(pTHX_ register const OP *o)
 {
     dVAR;
     SV      *op;
@@ -456,7 +458,7 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_ENTERLOOP:
@@ -464,13 +466,13 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_QR:
@@ -479,7 +481,7 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_HELEM:
@@ -494,7 +496,7 @@ sequence(pTHX_ register const OP *o)
 }
 
 STATIC UV
-sequence_num(pTHX_ const OP *o)
+S_sequence_num(pTHX_ const OP *o)
 {
     dVAR;
     SV     *op,
@@ -513,10 +515,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
     dVAR;
     UV      seq;
-    sequence(aTHX_ o);
+    sequence(o);
     Perl_dump_indent(aTHX_ level, file, "{\n");
     level++;
-    seq = sequence_num(aTHX_ o);
+    seq = sequence_num(o);
     if (seq)
        PerlIO_printf(file, "%-4"UVf, seq);
     else
@@ -526,7 +528,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                  (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next)
        PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
-                               sequence_num(aTHX_ o->op_next));
+                               sequence_num(o->op_next));
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
@@ -800,17 +802,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
        if (cLOOPo->op_redoop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_redoop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
        if (cLOOPo->op_nextop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_nextop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
        if (cLOOPo->op_lastop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_lastop));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -822,7 +824,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_AND:
        Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
        if (cLOGOPo->op_other)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOGOPo->op_other));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -1470,7 +1472,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
        if (CvSTART(sv))
-           Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv)));
+           Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv)));
        Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
         if (CvROOT(sv) && dumpops)
            do_op_dump(level+1, file, CvROOT(sv));
index f23dc98..b420278 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1142,6 +1142,7 @@ s |void*  |parse_body     |NULLOK char **env|XSINIT_t xsinit
 rs     |void   |run_body       |I32 oldscope
 s      |void   |call_body      |NN const OP *myop|bool is_eval
 s      |void*  |call_list_body |NN CV *cv
+s      |SV *   |incpush_if_exists|NN SV *dir
 #endif
 
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
@@ -1161,6 +1162,7 @@ s |const char *|group_end |NN const char *pat|NN const char *patend|char ender
 sR     |const char *|get_num   |NN const char *ppat|NN I32 *lenptr
 ns     |bool   |need_utf8      |NN const char *pat|NN const char *patend
 ns     |char   |first_symbol   |NN const char *pat|NN const char *patend
+sR     |char * |sv_exp_grow    |NN SV *sv|STRLEN needed
 #endif
 
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
@@ -1178,6 +1180,7 @@ s |void   |save_lines     |NULLOK AV *array|NN SV *sv
 sR     |OP*    |doeval         |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq
 sR     |PerlIO *|doopen_pm     |NN const char *name|NN const char *mode
 sR     |bool   |path_is_absolute|NN const char *name
+sR     |I32    |run_user_filter|int idx|NN SV *buf_sv|int maxlen
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
@@ -1271,6 +1274,8 @@ Es        |void   |to_byte_substr |NN regexp * prog
 #if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT)
 s      |CV*    |deb_curcv      |I32 ix
 s      |void   |debprof        |NN const OP *o
+s      |void   |sequence       |NULLOK const OP *o
+s      |UV     |sequence_num   |NULLOK const OP *o
 #endif
 
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
@@ -1347,7 +1352,7 @@ sR        |I32    |sublex_push
 sR     |I32    |sublex_start
 sR     |char * |filter_gets    |NN SV *sv|NN PerlIO *fp|STRLEN append
 sR     |HV *   |find_in_my_stash|NN const char *pkgname|I32 len
-sR     |char * |tokenize_use   |int|NN char*
+sR     |char * |tokenize_use   |int is_use|NN char*
 s      |SV*    |new_constant   |NULLOK const char *s|STRLEN len|NN const char *key|NN SV *sv \
                                |NULLOK SV *pv|NULLOK const char *type
 #  if defined(DEBUGGING)
@@ -1358,6 +1363,7 @@ s |void   |depcom
 s      |const char*|incl_perldb
 #  if defined(PERL_CR_FILTER)
 s      |I32    |cr_textfilter  |int idx|NULLOK SV *sv|int maxlen
+s      |void   |strip_return   |NN SV *sv
 #  endif
 #endif
 
@@ -1377,6 +1383,7 @@ s |SV*    |mess_alloc
 s      |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \
                                |NULLOK STRLEN *msglen|NULLOK I32* utf8
 s      |void   |vdie_common    |NULLOK const char *message|STRLEN msglen|I32 utf8
+sr     |char * |write_no_mem
 #endif
 
 #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index 3812e2d..32fa5b6 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define run_body               S_run_body
 #define call_body              S_call_body
 #define call_list_body         S_call_list_body
+#define incpush_if_exists      S_incpush_if_exists
 #endif
 #endif
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 #define get_num                        S_get_num
 #define need_utf8              S_need_utf8
 #define first_symbol           S_first_symbol
+#define sv_exp_grow            S_sv_exp_grow
 #endif
 #endif
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 #define doeval                 S_doeval
 #define doopen_pm              S_doopen_pm
 #define path_is_absolute       S_path_is_absolute
+#define run_user_filter                S_run_user_filter
 #endif
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define deb_curcv              S_deb_curcv
 #define debprof                        S_debprof
+#define sequence               S_sequence
+#define sequence_num           S_sequence_num
 #endif
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #  if defined(PERL_CR_FILTER)
 #ifdef PERL_CORE
 #define cr_textfilter          S_cr_textfilter
+#define strip_return           S_strip_return
 #endif
 #  endif
 #endif
 #define mess_alloc             S_mess_alloc
 #define vdie_croak_common      S_vdie_croak_common
 #define vdie_common            S_vdie_common
+#define write_no_mem           S_write_no_mem
 #endif
 #endif
 #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
 #define run_body(a)            S_run_body(aTHX_ a)
 #define call_body(a,b)         S_call_body(aTHX_ a,b)
 #define call_list_body(a)      S_call_list_body(aTHX_ a)
+#define incpush_if_exists(a)   S_incpush_if_exists(aTHX_ a)
 #endif
 #endif
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 #define get_num(a,b)           S_get_num(aTHX_ a,b)
 #define need_utf8              S_need_utf8
 #define first_symbol           S_first_symbol
+#define sv_exp_grow(a,b)       S_sv_exp_grow(aTHX_ a,b)
 #endif
 #endif
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 #define doeval(a,b,c,d)                S_doeval(aTHX_ a,b,c,d)
 #define doopen_pm(a,b)         S_doopen_pm(aTHX_ a,b)
 #define path_is_absolute(a)    S_path_is_absolute(aTHX_ a)
+#define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c)
 #endif
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define deb_curcv(a)           S_deb_curcv(aTHX_ a)
 #define debprof(a)             S_debprof(aTHX_ a)
+#define sequence(a)            S_sequence(aTHX_ a)
+#define sequence_num(a)                S_sequence_num(aTHX_ a)
 #endif
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #  if defined(PERL_CR_FILTER)
 #ifdef PERL_CORE
 #define cr_textfilter(a,b,c)   S_cr_textfilter(aTHX_ a,b,c)
+#define strip_return(a)                S_strip_return(aTHX_ a)
 #endif
 #  endif
 #endif
 #define mess_alloc()           S_mess_alloc(aTHX)
 #define vdie_croak_common(a,b,c,d)     S_vdie_croak_common(aTHX_ a,b,c,d)
 #define vdie_common(a,b,c)     S_vdie_common(aTHX_ a,b,c)
+#define write_no_mem()         S_write_no_mem(aTHX)
 #endif
 #endif
 #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
diff --git a/hv.c b/hv.c
index 1de2e01..6f5dd2e 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -65,7 +65,7 @@ STATIC HE*
 S_new_he(pTHX)
 {
     HE* he;
-    void **root = &PL_body_roots[HE_SVSLOT];
+    void ** const root = &PL_body_roots[HE_SVSLOT];
 
     LOCK_SV_MUTEX;
     if (!*root)
@@ -490,7 +490,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
-                       const char *nkey = strupr(savepvn(key,klen));
+                       const char * const nkey = strupr(savepvn(key,klen));
                        /* Note that this fetch is for nkey (the uppercased
                           key) whereas the store is for key (the original)  */
                        entry = hv_fetch_common(hv, Nullsv, nkey, klen,
@@ -1785,14 +1785,12 @@ value, you can get it through the macro C<HvFILL(tb)>.
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
-    HE *entry;
-
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (SvOOK(hv)) {
        struct xpvhv_aux *iter = HvAUX(hv);
-       entry = iter->xhv_eiter; /* HvEITER(hv) */
+       HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
        if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
            HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
@@ -2053,7 +2051,7 @@ Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
 {
     if (HeKLEN(entry) == HEf_SVKEY) {
        STRLEN len;
-       char *p = SvPV(HeKEY_sv(entry), len);
+       char * const p = SvPV(HeKEY_sv(entry), len);
        *retlen = len;
        return p;
     }
@@ -2117,8 +2115,9 @@ operation.
 SV *
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
-    HE *he;
-    if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+    HE * const he = hv_iternext_flags(hv, 0);
+
+    if (!he)
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
diff --git a/hv.h b/hv.h
index 7552267..4240af1 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -103,7 +103,7 @@ typedef struct {
 #endif
 #define PERL_HASH(hash,str,len) \
      STMT_START        { \
-       register const char *s_PeRlHaSh_tmp = str; \
+       register const char * const s_PeRlHaSh_tmp = str; \
        register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
        register I32 i_PeRlHaSh = len; \
        register U32 hash_PeRlHaSh = PERL_HASH_SEED; \
@@ -121,7 +121,7 @@ typedef struct {
 #ifdef PERL_HASH_INTERNAL_ACCESS
 #define PERL_HASH_INTERNAL(hash,str,len) \
      STMT_START        { \
-       register const char *s_PeRlHaSh_tmp = str; \
+       register const char * const s_PeRlHaSh_tmp = str; \
        register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
        register I32 i_PeRlHaSh = len; \
        register U32 hash_PeRlHaSh = PL_rehash_seed; \
index e7572cf..881ebd9 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -337,7 +337,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
     if (setlocale_failure) {
        char *p;
-       bool locwarn = (printwarn > 1 ||
+       const bool locwarn = (printwarn > 1 ||
                        (printwarn &&
                         (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
 
diff --git a/mg.c b/mg.c
index a475721..80b762c 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -485,14 +485,15 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    register const REGEXP *rx;
     PERL_UNUSED_ARG(sv);
 
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-       if (mg->mg_obj)         /* @+ */
-           return rx->nparens;
-       else                    /* @- */
-           return rx->lastparen;
+    if (PL_curpm) {
+       register const REGEXP * const rx = PM_GETRE(PL_curpm);
+       if (rx) {
+           return mg->mg_obj
+               ? rx->nparens       /* @+ */
+               : rx->lastparen;    /* @- */
+       }
     }
 
     return (U32)-1;
@@ -501,32 +502,33 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    register REGEXP *rx;
-
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-        register const I32 paren = mg->mg_len;
-        register I32 s;
-        register I32 t;
-       if (paren < 0)
-           return 0;
-       if (paren <= (I32)rx->nparens &&
-           (s = rx->startp[paren]) != -1 &&
-           (t = rx->endp[paren]) != -1)
-           {
-                register I32 i;
-               if (mg->mg_obj)         /* @+ */
-                   i = t;
-               else                    /* @- */
-                   i = s;
+    if (PL_curpm) {
+       register const REGEXP * const rx = PM_GETRE(PL_curpm);
+       if (rx) {
+           register const I32 paren = mg->mg_len;
+           register I32 s;
+           register I32 t;
+           if (paren < 0)
+               return 0;
+           if (paren <= (I32)rx->nparens &&
+               (s = rx->startp[paren]) != -1 &&
+               (t = rx->endp[paren]) != -1)
+               {
+                   register I32 i;
+                   if (mg->mg_obj)             /* @+ */
+                       i = t;
+                   else                        /* @- */
+                       i = s;
+
+                   if (i > 0 && RX_MATCH_UTF8(rx)) {
+                       const char * const b = rx->subbeg;
+                       if (b)
+                           i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+                   }
 
-               if (i > 0 && RX_MATCH_UTF8(rx)) {
-                   const char * const b = rx->subbeg;
-                   if (b)
-                       i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+                   sv_setiv(sv, i);
                }
-
-               sv_setiv(sv, i);
-           }
+       }
     }
     return 0;
 }
@@ -1158,7 +1160,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 static void
 restore_sigmask(pTHX_ SV *save_sv)
 {
-    const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
+    const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
     (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 }
 #endif
diff --git a/op.c b/op.c
index 6c32f66..fa69bc0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1520,7 +1520,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 STATIC OP *
 S_dup_attrlist(pTHX_ OP *o)
 {
-    OP *rop = Nullop;
+    OP *rop;
 
     /* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
      * where the first kid is OP_PUSHMARK and the remaining ones
@@ -1530,6 +1530,7 @@ S_dup_attrlist(pTHX_ OP *o)
        rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc(cSVOPo->op_sv));
     else {
        assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
+       rop = Nullop;
        for (o = cLISTOPo->op_first; o; o=o->op_sibling) {
            if (o->op_type == OP_CONST)
                rop = append_elem(OP_LIST, rop,
@@ -1734,7 +1735,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 OP *
 Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 {
-    OP *rops = Nullop;
+    OP *rops;
     int maybe_scalar = 0;
 
 /* [perl #17376]: this appears to be premature, and results in code such as
@@ -1749,6 +1750,7 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 #endif
     if (attrs)
        SAVEFREEOP(attrs);
+    rops = Nullop;
     o = my_kid(o, attrs, &rops);
     if (rops) {
        if (maybe_scalar && o->op_type == OP_PADSV) {
@@ -2772,7 +2774,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        cLISTOPx(expr)->op_first->op_sibling == cLISTOPx(expr)->op_last)
     {
        /* convert single element list to element */
-       OP* oe = expr;
+       OP* const oe = expr;
        expr = cLISTOPx(oe)->op_first->op_sibling;
        cLISTOPx(oe)->op_first->op_sibling = Nullop;
        cLISTOPx(oe)->op_last = Nullop;
@@ -4493,7 +4495,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     if (name || aname) {
        const char *s;
-       const char *tname = (name ? name : aname);
+       const char * const tname = (name ? name : aname);
 
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV * const sv = NEWSV(0,0);
@@ -4745,13 +4747,11 @@ void
 Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 {
     register CV *cv;
-    GV *gv;
 
-    if (o)
-       gv = gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM);
-    else
-       gv = gv_fetchpv("STDOUT", TRUE, SVt_PVFM);
-    
+    GV * const gv = o
+       ? gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM)
+       : gv_fetchpv("STDOUT", TRUE, SVt_PVFM);
+
 #ifdef GV_UNIQUE_CHECK
     if (GvUNIQUE(gv)) {
         Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
@@ -4977,7 +4977,7 @@ Perl_ck_bitop(pTHX_ OP *o)
 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
-    const OP *kid = cUNOPo->op_first;
+    const OP * const 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;
@@ -5164,7 +5164,7 @@ OP *
 Perl_ck_rvconst(pTHX_ register OP *o)
 {
     dVAR;
-    SVOP *kid = (SVOP*)cUNOPo->op_first;
+    SVOP * const kid = (SVOP*)cUNOPo->op_first;
 
     o->op_private |= (PL_hints & HINT_STRICT_REFS);
     if (kid->op_type == OP_CONST) {
@@ -5174,7 +5174,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
-           SV *rsv = SvRV(kidsv);
+           SV * const rsv = SvRV(kidsv);
            const int svtype = SvTYPE(rsv);
             const char *badtype = Nullch;
 
@@ -5406,7 +5406,7 @@ Perl_ck_fun(pTHX_ OP *o)
                    if (kid->op_type == OP_CONST &&
                        (kid->op_private & OPpCONST_BARE))
                    {
-                       OP *newop = newGVOP(OP_GV, 0,
+                       OP * const newop = newGVOP(OP_GV, 0,
                            gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVIO) );
                        if (!(o->op_private & 1) && /* if not unop */
                            kid == cLISTOPo->op_last)
@@ -5446,7 +5446,7 @@ Perl_ck_fun(pTHX_ OP *o)
                            else if (kid->op_type == OP_RV2SV
                                     && kUNOP->op_first->op_type == OP_GV)
                            {
-                               GV *gv = cGVOPx_gv(kUNOP->op_first);
+                               GV * const gv = cGVOPx_gv(kUNOP->op_first);
                                name = GvNAME(gv);
                                len = GvNAMELEN(gv);
                            }
@@ -6349,6 +6349,7 @@ Perl_ck_subr(pTHX_ OP *o)
                     break;
                case ']':
                     if (contextclass) {
+                        /* XXX We shouldn't be modifying proto, so we can const proto */
                         char *p = proto;
                         const char s = *p;
                         contextclass = 0;
@@ -6605,7 +6606,7 @@ Perl_peep(pTHX_ register OP *o)
        case OP_PADAV:
        case OP_GV:
            if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) {
-               OP* pop = (o->op_type == OP_PADAV) ?
+               OP* const pop = (o->op_type == OP_PADAV) ?
                            o->op_next : o->op_next->op_next;
                IV i;
                if (pop && pop->op_type == OP_CONST &&
diff --git a/op.h b/op.h
index 0f54a67..5fbce83 100644 (file)
--- a/op.h
+++ b/op.h
@@ -289,7 +289,10 @@ struct pmop {
 
 #ifdef USE_ITHREADS
 #define PM_GETRE(o)     (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset])))
-#define PM_SETRE(o,r)   STMT_START { SV* sv = PL_regex_pad[(o)->op_pmoffset]; sv_setiv(sv, PTR2IV(r)); } STMT_END
+#define PM_SETRE(o,r)   STMT_START { \
+                            SV* const sv = PL_regex_pad[(o)->op_pmoffset]; \
+                            sv_setiv(sv, PTR2IV(r)); \
+                        } STMT_END
 #define PM_GETRE_SAFE(o) (PL_regex_pad ? PM_GETRE(o) : (REGEXP*)0)
 #define PM_SETRE_SAFE(o,r) if (PL_regex_pad) PM_SETRE(o,r)
 #else
diff --git a/pp.c b/pp.c
index 09d71ce..254e840 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -78,7 +78,7 @@ PP(pp_padav)
        if (SvMAGICAL(TARG)) {
            U32 i;
            for (i=0; i < (U32)maxarg; i++) {
-               SV ** const svp = av_fetch((AV*)TARG, i, FALSE);
+               SV * const * const svp = av_fetch((AV*)TARG, i, FALSE);
                SP[i+1] = (svp) ? *svp : &PL_sv_undef;
            }
        }
@@ -160,13 +160,13 @@ PP(pp_rv2gv)
                    GV *gv;
                    if (cUNOP->op_targ) {
                        STRLEN len;
-                       SV *namesv = PAD_SV(cUNOP->op_targ);
-                       const char *name = SvPV(namesv, len);
+                       SV * const namesv = PAD_SV(cUNOP->op_targ);
+                       const char * const name = SvPV(namesv, len);
                        gv = (GV*)NEWSV(0,0);
                        gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
                    }
                    else {
-                       const char *name = CopSTASHPV(PL_curcop);
+                       const char * const name = CopSTASHPV(PL_curcop);
                        gv = newGVgen(name);
                    }
                    if (SvTYPE(sv) < SVt_RV)
@@ -364,7 +364,7 @@ PP(pp_prototype)
 
     ret = &PL_sv_undef;
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
-       const char *s = SvPVX_const(TOPs);
+       const char * const s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6);
            if (code < 0) {     /* Overridable. */
@@ -755,7 +755,7 @@ PP(pp_undef)
     case SVt_PVFM:
        {
            /* let user-undef'd sub keep its identity */
-           GV* gv = CvGV((CV*)sv);
+           GV* const gv = CvGV((CV*)sv);
            cv_undef((CV*)sv);
            CvGV((CV*)sv) = gv;
        }
@@ -1260,7 +1260,7 @@ PP(pp_modulo)
                 if (!left_neg) {
                     left = SvUVX(POPs);
                 } else {
-                    IV aiv = SvIVX(POPs);
+                   const IV aiv = SvIVX(POPs);
                     if (aiv >= 0) {
                         left = aiv;
                         left_neg = FALSE; /* effectively it's a UV now */
@@ -1352,7 +1352,7 @@ PP(pp_repeat)
              else
                   count = uv;
         } else {
-             IV iv = SvIV(sv);
+             const IV iv = SvIV(sv);
              if (iv < 0)
                   count = 0;
              else
@@ -1370,12 +1370,10 @@ PP(pp_repeat)
         count = SvIVx(sv);
     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
-       I32 items = SP - MARK;
-       I32 max;
-       static const char oom_list_extend[] =
-         "Out of memory during list extend";
+       static const char oom_list_extend[] = "Out of memory during list extend";
+       const I32 items = SP - MARK;
+       const I32 max = items * count;
 
-       max = items * count;
        MEM_WRAP_CHECK_1(max, SV*, oom_list_extend);
        /* Did the max computation overflow? */
        if (items > 0 && max > 0 && (max < items || max < count))
@@ -1421,7 +1419,7 @@ PP(pp_repeat)
            SP -= items;
     }
     else {     /* Note: mark already snarfed by pp_list */
-       SV *tmpstr = POPs;
+       SV * const tmpstr = POPs;
        STRLEN len;
        bool isutf;
        static const char oom_string_extend[] =
@@ -1604,11 +1602,11 @@ PP(pp_right_shift)
     {
       const IV shift = POPi;
       if (PL_op->op_private & HINT_INTEGER) {
-       IV i = TOPi;
+       const IV i = TOPi;
        SETi(i >> shift);
       }
       else {
-       UV u = TOPu;
+       const UV u = TOPu;
        SETu(u >> shift);
       }
       RETURN;
@@ -1933,8 +1931,8 @@ PP(pp_ne)
     if (SvIOK(TOPs)) {
        SvIV_please(TOPm1s);
        if (SvIOK(TOPm1s)) {
-           bool auvok = SvUOK(TOPm1s);
-           bool buvok = SvUOK(TOPs);
+           const bool auvok = SvUOK(TOPm1s);
+           const bool buvok = SvUOK(TOPs);
        
            if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
                 /* Casting IV to UV before comparison isn't going to matter
@@ -1992,8 +1990,8 @@ PP(pp_ncmp)
     dSP; dTARGET; tryAMAGICbin(ncmp,0);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
-        UV right = PTR2UV(SvRV(POPs));
-        UV left = PTR2UV(SvRV(TOPs));
+       const UV right = PTR2UV(SvRV(POPs));
+       const UV left = PTR2UV(SvRV(TOPs));
        SETi((left > right) - (left < right));
        RETURN;
     }
@@ -2680,11 +2678,7 @@ PP(pp_rand)
 PP(pp_srand)
 {
     dSP;
-    UV anum;
-    if (MAXARG < 1)
-       anum = seed();
-    else
-       anum = POPu;
+    const UV anum = (MAXARG < 1) ? seed() : POPu;
     (void)seedDrand01((Rand_seed_t)anum);
     PL_srand_called = TRUE;
     EXTEND(SP, 1);
@@ -2883,7 +2877,7 @@ PP(pp_oct)
 PP(pp_length)
 {
     dSP; dTARGET;
-    SV *sv = TOPs;
+    SV * const sv = TOPs;
 
     if (DO_UTF8(sv))
        SETi(sv_len_utf8(sv));
@@ -3463,7 +3457,7 @@ PP(pp_uc)
                if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
                    /* If the eventually required minimum size outgrows
                     * the available space, we need to grow. */
-                   UV o = d - (U8*)SvPVX_const(TARG);
+                   const UV o = d - (U8*)SvPVX_const(TARG);
 
                    /* If someone uppercases one million U+03B0s we
                     * SvGROW() one million times.  Or we could try
@@ -3566,7 +3560,7 @@ PP(pp_lc)
                if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
                    /* If the eventually required minimum size outgrows
                     * the available space, we need to grow. */
-                   UV o = d - (U8*)SvPVX_const(TARG);
+                   const UV o = d - (U8*)SvPVX_const(TARG);
 
                    /* If someone lowercases one million U+0130s we
                     * SvGROW() one million times.  Or we could try
@@ -3811,7 +3805,7 @@ PP(pp_exists)
 
     if (PL_op->op_private & OPpEXISTS_SUB) {
        GV *gv;
-       SV *sv = POPs;
+       SV * const sv = POPs;
        CV * const cv = sv_2cv(sv, &hv, &gv, FALSE);
        if (cv)
            RETPUSHYES;
index 45ca9ea..b49a5b5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -38,8 +38,6 @@
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
-static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
-
 PP(pp_wantarray)
 {
     dSP;
@@ -1561,7 +1559,7 @@ PP(pp_caller)
     if (!MAXARG)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-       GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
+       GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
        /* So is ccstack[dbcxix]. */
        if (isGV(cvgv)) {
            SV * const sv = NEWSV(49, 0);
@@ -1611,9 +1609,8 @@ PP(pp_caller)
        const int off = AvARRAY(ary) - AvALLOC(ary);
 
        if (!PL_dbargs) {
-           GV* tmpgv;
-           PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
-                               SVt_PVAV)));
+           GV* const tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV);
+           PL_dbargs = GvAV(gv_AVadd(tmpgv));
            GvMULTI_on(tmpgv);
            AvREAL_off(PL_dbargs);      /* XXX should be REIFY (see av.h) */
        }
@@ -1630,7 +1627,7 @@ PP(pp_caller)
                             HINT_PRIVATE_MASK)));
     {
        SV * mask ;
-       SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+       SV * const old_warnings = cx->blk_oldcop->cop_warnings ;
 
        if  (old_warnings == pWARN_NONE ||
                (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
@@ -1640,7 +1637,7 @@ PP(pp_caller)
            /* Get the bit mask for $warnings::Bits{all}, because
             * it could have been extended by warnings::register */
            SV **bits_all;
-           HV *bits = get_hv("warnings::Bits", FALSE);
+           HV * const bits = get_hv("warnings::Bits", FALSE);
            if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
                mask = newSVsv(*bits_all);
            }
@@ -1658,12 +1655,7 @@ PP(pp_caller)
 PP(pp_reset)
 {
     dSP;
-    const char *tmps;
-
-    if (MAXARG < 1)
-       tmps = "";
-    else
-       tmps = POPpconstx;
+    const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
     sv_reset(tmps, CopSTASH(PL_curcop));
     PUSHs(&PL_sv_yes);
     RETURN;
@@ -1683,14 +1675,12 @@ PP(pp_dbstate)
            || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
        dSP;
-       register CV *cv;
        register PERL_CONTEXT *cx;
        const I32 gimme = G_ARRAY;
        U8 hasargs;
-       GV *gv;
+       GV * const gv = PL_DBgv;
+       register CV * const cv = GvCV(gv);
 
-       gv = PL_DBgv;
-       cv = GvCV(gv);
        if (!cv)
            DIE(aTHX_ "No DB::DB routine defined");
 
@@ -1760,7 +1750,7 @@ PP(pp_enteriter)
 #endif
     }
     else {
-       GV *gv = (GV*)POPs;
+       GV * const gv = (GV*)POPs;
        svp = &GvSV(gv);                        /* symbol table variable */
        SAVEGENERICSV(*svp);
        *svp = NEWSV(0,0);
@@ -1781,7 +1771,7 @@ PP(pp_enteriter)
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
        if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
            dPOPss;
-           SV *right = (SV*)cx->blk_loop.iterary;
+           SV * const right = (SV*)cx->blk_loop.iterary;
            SvGETMAGIC(sv);
            SvGETMAGIC(right);
            if (RANGE_IS_NUMERIC(sv,right)) {
@@ -1882,7 +1872,6 @@ PP(pp_leaveloop)
 PP(pp_return)
 {
     dVAR; dSP; dMARK;
-    I32 cxix;
     register PERL_CONTEXT *cx;
     bool popsub2 = FALSE;
     bool clear_errsv = FALSE;
@@ -1893,7 +1882,8 @@ PP(pp_return)
     SV *sv;
     OP *retop;
 
-    cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopoptosub(cxstack_ix);
+
     if (cxix < 0) {
        if (CxMULTICALL(cxstack)) { /* In this case we must be in a
                                     * sort block, which is a CXt_NULL
@@ -2536,7 +2526,7 @@ PP(pp_goto)
        /* push wanted frames */
 
        if (*enterops && enterops[1]) {
-           OP *oldop = PL_op;
+           OP * const oldop = PL_op;
            ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
            for (; enterops[ix]; ix++) {
                PL_op = enterops[ix];
@@ -3070,7 +3060,7 @@ PP(pp_require)
        DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
     if (PL_op->op_type == OP_REQUIRE) {
-       SV ** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+       SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
        if ( svp ) {
            if (*svp != &PL_sv_undef)
                RETPUSHYES;
@@ -3347,7 +3337,7 @@ PP(pp_require)
     PL_compiling.cop_io = Nullsv;
 
     if (filter_sub || filter_child_proc) {
-       SV * const datasv = filter_add(run_user_filter, Nullsv);
+       SV * const datasv = filter_add(S_run_user_filter, Nullsv);
        IoLINES(datasv) = filter_has_file;
        IoFMT_GV(datasv) = (GV *)filter_child_proc;
        IoTOP_GV(datasv) = (GV *)filter_state;
@@ -3842,14 +3832,14 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize)
 }
 
 static I32
-run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
+S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     dVAR;
-    SV *datasv = FILTER_DATA(idx);
+    SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
-    SV *filter_state = (SV *)IoTOP_GV(datasv);
-    SV *filter_sub = (SV *)IoBOTTOM_GV(datasv);
+    GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
+    SV * const filter_state = (SV *)IoTOP_GV(datasv);
+    SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int len = 0;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
@@ -3906,7 +3896,7 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
            SvREFCNT_dec(filter_sub);
            IoBOTTOM_GV(datasv) = Nullgv;
        }
-       filter_del(run_user_filter);
+       filter_del(S_run_user_filter);
     }
 
     return len;
@@ -3919,11 +3909,12 @@ S_path_is_absolute(pTHX_ const char *name)
 {
     if (PERL_FILE_IS_ABSOLUTE(name)
 #ifdef MACOS_TRADITIONAL
-       || (*name == ':'))
+       || (*name == ':')
 #else
        || (*name == '.' && (name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/'))))
+                            (name[1] == '.' && name[2] == '/')))
 #endif
+        )
     {
        return TRUE;
     }
index 173aca2..bf8f7b7 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -111,8 +111,8 @@ PP(pp_sassign)
     dSP; dPOPTOPssrl;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
-       SV *temp;
-       temp = left; left = right; right = temp;
+       SV * const temp = left;
+       left = right; right = temp;
     }
     if (PL_tainting && PL_tainted && !SvTAINTED(left))
        TAINT_NOT;
@@ -259,8 +259,8 @@ PP(pp_eq)
           right argument if we know the left is integer.  */
       SvIV_please(TOPm1s);
        if (SvIOK(TOPm1s)) {
-           bool auvok = SvUOK(TOPm1s);
-           bool buvok = SvUOK(TOPs);
+           const bool auvok = SvUOK(TOPm1s);
+           const bool buvok = SvUOK(TOPs);
        
            if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
                 /* Casting IV to UV before comparison isn't going to matter
@@ -269,8 +269,8 @@ PP(pp_eq)
                    differ from normal zero. As I understand it. (Need to
                    check - is negative zero implementation defined behaviour
                    anyway?). NWC  */
-               UV buv = SvUVX(POPs);
-               UV auv = SvUVX(TOPs);
+               const UV buv = SvUVX(POPs);
+               const UV auv = SvUVX(TOPs);
                
                SETs(boolSV(auv == buv));
                RETURN;
@@ -558,7 +558,7 @@ PP(pp_aelemfast)
     AV *av = PL_op->op_flags & OPf_SPECIAL ?
                (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
     const U32 lval = PL_op->op_flags & OPf_MOD;
-    SV** svp = av_fetch(av, PL_op->op_private, lval);
+    SV** const svp = av_fetch(av, PL_op->op_private, lval);
     SV *sv = (svp ? *svp : &PL_sv_undef);
     EXTEND(SP, 1);
     if (!lval && SvGMAGICAL(sv))       /* see note in pp_helem() */
@@ -601,15 +601,10 @@ PP(pp_pushre)
 PP(pp_print)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    GV *gv;
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
-
-    if (PL_op->op_flags & OPf_STACKED)
-       gv = (GV*)*++MARK;
-    else
-       gv = PL_defoutgv;
+    GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
 
     if (gv && (io = GvIO(gv))
        && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
index a7591de..093e601 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -735,7 +735,7 @@ STMT_START {                                        \
     STRLEN glen = (in_len);                    \
     if (utf8) glen *= UTF8_EXPAND;             \
     if ((cur) + glen >= (start) + SvLEN(cat)) {        \
-       (start) = sv_exp_grow(aTHX_ cat, glen); \
+       (start) = sv_exp_grow(cat, glen);       \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
 } STMT_END
@@ -748,7 +748,7 @@ STMT_START {                                        \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
         SvCUR_set((cat), (cur) - (start));     \
-       (start) = sv_exp_grow(aTHX_ cat, gl);   \
+       (start) = sv_exp_grow(cat, gl);         \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
     PUSH_BYTES(utf8, cur, buf, glen);          \
@@ -2502,7 +2502,7 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
    Only grows the string if there is an actual lack of space
 */
 STATIC char *
-sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
+S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
     const STRLEN cur = SvCUR(sv);
     const STRLEN len = SvLEN(sv);
     STRLEN extend;
index 34d21fd..7c8ab2f 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1511,7 +1511,7 @@ PP(pp_sort)
        else {
            cv = sv_2cv(*++MARK, &stash, &gv, 0);
            if (cv && SvPOK(cv)) {
-               const char *proto = SvPV_nolen_const((SV*)cv);
+               const char * const proto = SvPV_nolen_const((SV*)cv);
                if (proto && strEQ(proto, "$$")) {
                    hasargs = TRUE;
                }
index 65971c1..fe20ead 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -877,9 +877,9 @@ PP(pp_untie)
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
-       CV *cv = NULL;
         if (obj) {
            GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
+           CV *cv;
            if (gv && isGV(gv) && (cv = GvCV(gv))) {
               PUSHMARK(SP);
               XPUSHs(SvTIED_obj((SV*)gv, mg));
diff --git a/proto.h b/proto.h
index 6ebd968..7c7e2ba 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3178,6 +3178,9 @@ STATIC void       S_call_body(pTHX_ const OP *myop, bool is_eval)
 STATIC void*   S_call_list_body(pTHX_ CV *cv)
                        __attribute__nonnull__(pTHX_1);
 
+STATIC SV *    S_incpush_if_exists(pTHX_ SV *dir)
+                       __attribute__nonnull__(pTHX_1);
+
 #endif
 
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
@@ -3234,6 +3237,10 @@ STATIC char      S_first_symbol(const char *pat, const char *patend)
                        __attribute__nonnull__(1)
                        __attribute__nonnull__(2);
 
+STATIC char *  S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+
 #endif
 
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
@@ -3287,6 +3294,10 @@ STATIC bool      S_path_is_absolute(pTHX_ const char *name)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
+STATIC I32     S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_2);
+
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
@@ -3556,6 +3567,8 @@ STATIC CV*        S_deb_curcv(pTHX_ I32 ix);
 STATIC void    S_debprof(pTHX_ const OP *o)
                        __attribute__nonnull__(pTHX_1);
 
+STATIC void    S_sequence(pTHX_ const OP *o);
+STATIC UV      S_sequence_num(pTHX_ const OP *o);
 #endif
 
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
@@ -3749,7 +3762,7 @@ STATIC HV *       S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
-STATIC char *  S_tokenize_use(pTHX_ int, char*)
+STATIC char *  S_tokenize_use(pTHX_ int is_use, char*)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_2);
 
@@ -3765,6 +3778,9 @@ STATIC void       S_depcom(pTHX);
 STATIC const char*     S_incl_perldb(pTHX);
 #  if defined(PERL_CR_FILTER)
 STATIC I32     S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen);
+STATIC void    S_strip_return(pTHX_ SV *sv)
+                       __attribute__nonnull__(pTHX_1);
+
 #  endif
 #endif
 
@@ -3789,6 +3805,9 @@ STATIC COP*       S_closest_cop(pTHX_ COP *cop, const OP *o)
 STATIC SV*     S_mess_alloc(pTHX);
 STATIC const char *    S_vdie_croak_common(pTHX_ const char *pat, va_list *args, STRLEN *msglen, I32* utf8);
 STATIC void    S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8);
+STATIC char *  S_write_no_mem(pTHX)
+                       __attribute__noreturn__;
+
 #endif
 
 #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
index 7d5d8a3..d943d14 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5822,8 +5822,9 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o)
     else if (k == ANYOF) {
        int i, rangestart = -1;
        const U8 flags = ANYOF_FLAGS(o);
-       const char * const anyofs[] = { /* Should be synchronized with
-                                        * ANYOF_ #xdefines in regcomp.h */
+
+       /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */
+       static const char * const anyofs[] = {
            "\\w",
            "\\W",
            "\\s",
diff --git a/sv.c b/sv.c
index 464c436..94ada28 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -357,7 +357,7 @@ and split it into a list of free SVs.
 void
 Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 {
-    SV* sva = (SV*)ptr;
+    SV* const sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
 
diff --git a/taint.c b/taint.c
index ed1af74..9de7748 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -161,7 +161,7 @@ Perl_taint_env(pTHX)
 #endif /* !VMS */
 
     for (e = misc_env; *e; e++) {
-       SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
+       SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
        if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
            TAINT;
            taint_proper("Insecure $ENV{%s}%s", *e);
diff --git a/toke.c b/toke.c
index b8d20b7..5a0a5b3 100644 (file)
--- a/toke.c
+++ b/toke.c
 #define yychar (*PL_yycharp)
 #define yylval (*PL_yylvalp)
 
-static const char ident_too_long[] =
-  "Identifier too long";
-static const char c_without_g[] =
-  "Use of /c modifier is meaningless without /g";
-static const char c_in_subst[] =
-  "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] = "Identifier too long";
 
 static void restore_rsfp(pTHX_ void *f);
 #ifndef PERL_NO_UTF16_FILTER
@@ -2651,10 +2646,9 @@ Perl_yylex(pTHX)
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets) {
-               if (PL_lex_formbrack)
-                   yyerror("Format not terminated");
-                else
-                   yyerror("Missing right curly or square bracket");
+               yyerror(PL_lex_formbrack
+                   ? "Format not terminated"
+                   : "Missing right curly or square bracket");
            }
             DEBUG_T( { PerlIO_printf(Perl_debug_log,
                         "### Tokener got EOF\n");
@@ -3319,11 +3313,9 @@ Perl_yylex(pTHX)
                   context messages from yyerror().
                 */
                PL_bufptr = s;
-               if (!*s)
-                   yyerror("Unterminated attribute list");
-               else
-                   yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list",
-                                     q, *s, q));
+               yyerror( *s
+                   ? Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", q, *s, q)
+                   : "Unterminated attribute list" );
                if (attrs)
                    op_free(attrs);
                OPERATOR(':');
@@ -9367,7 +9359,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
            && ckWARN(WARN_REGEXP))
     {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
+        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
     }
 
     pm->op_pmpermflags = pm->op_pmflags;
@@ -9419,10 +9411,8 @@ S_scan_subst(pTHX_ char *start)
            break;
     }
 
-    /* /c is not meaningful with s/// */
-    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
-    {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
+    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
+        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
     }
 
     if (es) {
@@ -10932,7 +10922,7 @@ S_swallow_bom(pTHX_ U8 *s)
 static void
 restore_rsfp(pTHX_ void *f)
 {
-    PerlIO *fp = (PerlIO*)f;
+    PerlIO * const fp = (PerlIO*)f;
 
     if (PL_rsfp == PerlIO_stdin())
        PerlIO_clearerr(PL_rsfp);
@@ -11020,16 +11010,15 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv)
     }
 
     if (!isALPHA(*pos)) {
-       UV rev;
        U8 tmpbuf[UTF8_MAXBYTES+1];
-       U8 *tmpend;
 
        if (*s == 'v') s++;  /* get past 'v' */
 
        sv_setpvn(sv, "", 0);
 
        for (;;) {
-           rev = 0;
+           U8 *tmpend;
+           UV rev = 0;
            {
                /* this is atoi() that tolerates underscores */
                const char *end = pos;
diff --git a/utf8.c b/utf8.c
index 9387434..2356255 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1759,17 +1759,17 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
     STRLEN lcur, xcur, scur;
 
     HV* const hv = (HV*)SvRV(swash);
-    SV** listsvp = hv_fetch(hv, "LIST", 4, FALSE);
-    SV** typesvp = hv_fetch(hv, "TYPE", 4, FALSE);
-    SV** bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
-    SV** nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
-    SV** extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
-    U8*  typestr = (U8*)SvPV_nolen(*typesvp);
-    int  typeto  = typestr[0] == 'T' && typestr[1] == 'o';
-    STRLEN bits  = SvUV(*bitssvp);
-    STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
-    UV     none  = SvUV(*nonesvp);
-    UV     end   = start + span;
+    SV** const listsvp = hv_fetch(hv, "LIST", 4, FALSE);
+    SV** const typesvp = hv_fetch(hv, "TYPE", 4, FALSE);
+    SV** const bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
+    SV** const nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
+    SV** const extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
+    const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
+    const int  typeto  = typestr[0] == 'T' && typestr[1] == 'o';
+    const STRLEN bits  = SvUV(*bitssvp);
+    const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
+    const UV     none  = SvUV(*nonesvp);
+    const UV     end   = start + span;
 
     if (bits != 1 && bits != 8 && bits != 16 && bits != 32) {
        Perl_croak(aTHX_ "panic: swash_get doesn't expect bits %"UVuf,
@@ -1782,7 +1782,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
     SvGROW(swatch, scur + 1);
     s = (U8*)SvPVX(swatch);
     if (octets && none) {
-       const U8* e = s + scur;
+       const U8* const e = s + scur;
        while (s < e) {
            if (bits == 8)
                *s++ = (U8)(none & 0xff);
@@ -1813,7 +1813,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
        STRLEN numlen;
        I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
 
-       U8* nl = (U8*)memchr(l, '\n', lend - l);
+       U8* const nl = (U8*)memchr(l, '\n', lend - l);
 
        numlen = lend - l;
        min = grok_hex((char *)l, &numlen, &flags, NULL);
@@ -1915,7 +1915,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
            if (min < start)
                min = start;
            for (key = min; key <= max; key++) {
-               STRLEN offset = (STRLEN)(key - start);
+               const STRLEN offset = (STRLEN)(key - start);
                if (key >= end)
                    goto go_out_list;
                s[offset >> 3] |= 1 << (offset & 7);
@@ -2151,7 +2151,7 @@ Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV f
         u = utf8_to_uvchr((U8*)s, 0);
         if (u < 256) {
             const unsigned char c = (unsigned char)u & 0xFF;
-            if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) {
+            if (flags & UNI_DISPLAY_BACKSLASH) {
                 switch (c) {
                 case '\n':
                     ok = 'n'; break;
diff --git a/util.c b/util.c
index a8213fa..ec0ba8c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -64,7 +64,7 @@ S_write_no_mem(pTHX)
     PerlLIO_write(PerlIO_fileno(Perl_error_log),
                  PL_no_mem, strlen(PL_no_mem));
     my_exit(1);
-    return Nullch;
+    NORETURN_FUNCTION_END
 }
 
 /* paranoid version of system's malloc() */
@@ -101,7 +101,7 @@ Perl_safesysmalloc(MEM_SIZE size)
     else if (PL_nomemok)
        return Nullch;
     else {
-       return S_write_no_mem(aTHX);
+       return write_no_mem();
     }
     /*NOTREACHED*/
 }
@@ -158,7 +158,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
     else if (PL_nomemok)
        return Nullch;
     else {
-       return S_write_no_mem(aTHX);
+       return write_no_mem();
     }
     /*NOTREACHED*/
 }
@@ -221,10 +221,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
     }
     else if (PL_nomemok)
        return Nullch;
-    else {
-       return S_write_no_mem(aTHX);
-    }
-    /*NOTREACHED*/
+    return write_no_mem();
 }
 
 /* These must be defined when not using Perl's malloc for binary
@@ -851,7 +848,7 @@ Perl_savesharedpv(pTHX_ const char *pv)
     pvlen = strlen(pv)+1;
     newaddr = (char*)PerlMemShared_malloc(pvlen);
     if (!newaddr) {
-       return S_write_no_mem(aTHX);
+       return write_no_mem();
     }
     return memcpy(newaddr,pv,pvlen);
 }