g++ large patch
Jarkko Hietaniemi [Fri, 4 Aug 2006 08:58:27 +0000 (11:58 +0300)]
Message-ID: <44D2E203.5050201@iki.fi>

p4raw-id: //depot/perl@28662

25 files changed:
cflags.SH
deb.c
dump.c
embed.fnc
embed.h
gv.c
hv.c
mathoms.c
mg.c
op.c
perl.h
perlio.c
pp_ctl.c
pp_hot.c
pp_pack.c
pp_sys.c
proto.h
regcomp.c
regexec.c
scope.c
sv.c
toke.c
utf8.c
util.c
warnings.h

index c32d5f8..41e0040 100755 (executable)
--- a/cflags.SH
+++ b/cflags.SH
@@ -94,16 +94,12 @@ case "$cc" in
 *g++*) warn="`echo $warn|sed 's/-Wdeclaration-after-statement/ /'`" ;;
 esac
 
-extra=''
+# stdflags currently unused.
+stdflags=''
 
-# C and C++ have different rules for const strings;
-# without the -fno-const-strings g++ cannot handle our habit
-# of mixing char literals and char pointers.
-case "$cc" in
-*g++*) extra="$extra -fno-const-strings" ;;
-esac
+extra=''
 
-stdflags=''
+# Code to set any extra flags here.
 
 echo "Extracting cflags (with variable substitutions)"
 : This section of the file will have variable substitutions done on it.
diff --git a/deb.c b/deb.c
index 1d3de4c..58411d1 100644 (file)
--- a/deb.c
+++ b/deb.c
@@ -204,7 +204,9 @@ Perl_deb_stack_all(pTHX)
     for (;;)
     {
         const size_t 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];
+        const char * const si_name =
+           (const char *)
+           ((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/dump.c b/dump.c
index 03bdab3..fc3e8f3 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -718,8 +718,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                  "%*sTYPE = %s  ===> ",
                  (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next)
-       PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
-                               sequence_num(o->op_next));
+       PerlIO_printf(file, (const char *)(seq ? "%"UVf"\n" : "(%"UVf")\n"),
+                     sequence_num(o->op_next));
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
index d69d87e..0342c39 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1427,9 +1427,6 @@ s |void   |glob_assign_ref|NN SV *dstr|NN SV *sstr
 #  if defined(USE_ITHREADS)
 sRn    |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *tbl|NN const void *sv
 #  endif
-s      |SV *   |find_hash_subscript|NULLOK HV *hv|NN SV *val
-s      |I32    |find_array_subscript|NULLOK AV *av|NN SV *val
-s      |SV *   |find_uninit_var|NULLOK OP *obase|NULLOK SV *uninit_sv|bool match
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
@@ -1613,7 +1610,10 @@ ApoR     |I32    |hv_placeholders_get    |NN HV* hv
 Apo    |void   |hv_placeholders_set    |NN HV* hv|I32 ph
 
 p      |SV*    |magic_scalarpack|NN HV* hv|NN MAGIC* mg
-#ifdef PERL_IN_SV_C
+
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
+s      |SV *   |find_hash_subscript|NULLOK HV *hv|NN SV *val
+s      |I32    |find_array_subscript|NULLOK AV *av|NN SV *val
 sMd    |SV*    |find_uninit_var|NULLOK OP* obase|NULLOK SV* uninit_sv|bool top
 #endif
 
diff --git a/embed.h b/embed.h
index cb2193b..1536130 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define ptr_table_find         S_ptr_table_find
 #endif
 #  endif
-#ifdef PERL_CORE
-#define find_hash_subscript    S_find_hash_subscript
-#define find_array_subscript   S_find_array_subscript
-#define find_uninit_var                S_find_uninit_var
-#endif
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #ifdef PERL_CORE
 #define magic_scalarpack       Perl_magic_scalarpack
 #endif
-#ifdef PERL_IN_SV_C
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
+#define find_hash_subscript    S_find_hash_subscript
+#define find_array_subscript   S_find_array_subscript
 #define find_uninit_var                S_find_uninit_var
 #endif
 #endif
 #define ptr_table_find         S_ptr_table_find
 #endif
 #  endif
-#ifdef PERL_CORE
-#define find_hash_subscript(a,b)       S_find_hash_subscript(aTHX_ a,b)
-#define find_array_subscript(a,b)      S_find_array_subscript(aTHX_ a,b)
-#define find_uninit_var(a,b,c) S_find_uninit_var(aTHX_ a,b,c)
-#endif
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #ifdef PERL_CORE
 #define magic_scalarpack(a,b)  Perl_magic_scalarpack(aTHX_ a,b)
 #endif
-#ifdef PERL_IN_SV_C
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
+#define find_hash_subscript(a,b)       S_find_hash_subscript(aTHX_ a,b)
+#define find_array_subscript(a,b)      S_find_array_subscript(aTHX_ a,b)
 #define find_uninit_var(a,b,c) S_find_uninit_var(aTHX_ a,b,c)
 #endif
 #endif
diff --git a/gv.c b/gv.c
index da6b2ad..203b05c 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -81,12 +81,13 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
          * this is a dirhandle.
          */
        const char * const fh =
-                        PL_op->op_type ==  OP_READDIR ||
-                         PL_op->op_type ==  OP_TELLDIR ||
-                         PL_op->op_type ==  OP_SEEKDIR ||
-                         PL_op->op_type ==  OP_REWINDDIR ||
-                         PL_op->op_type ==  OP_CLOSEDIR ?
-                         "dirhandle" : "filehandle";
+           (const char *)
+           (PL_op->op_type ==  OP_READDIR ||
+            PL_op->op_type ==  OP_TELLDIR ||
+            PL_op->op_type ==  OP_SEEKDIR ||
+            PL_op->op_type ==  OP_REWINDDIR ||
+            PL_op->op_type ==  OP_CLOSEDIR ?
+            "dirhandle" : "filehandle");
         Perl_croak(aTHX_ "Bad symbol for %s", fh);
     }
 
@@ -161,7 +162,8 @@ GP *
 Perl_newGP(pTHX_ GV *const gv)
 {
     GP *gp;
-    const char *const file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
+    const char *const file =
+       CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (const char *)"";
     STRLEN len = strlen(file);
     U32 hash;
 
@@ -313,6 +315,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     GV** gvp;
     CV* cv;
     const char *hvname;
+    HV* lastchance = NULL;
 
     /* UNIVERSAL methods should be callable without a stash */
     if (!stash) {
@@ -400,7 +403,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* if at top level, try UNIVERSAL */
 
     if (level == 0 || level == -1) {
-       HV* const lastchance = gv_stashpvs("UNIVERSAL", FALSE);
+       lastchance = gv_stashpvs("UNIVERSAL", FALSE);
 
        if (lastchance) {
            if ((gv = gv_fetchmeth(lastchance, name, len,
@@ -1274,7 +1277,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
        SvOK_off(sv);
        return;
     }
-    sv_setpv(sv, prefix ? prefix : "");
+    sv_setpv(sv, prefix ? prefix : (const char *)"");
 
     name = HvNAME_get(hv);
     if (name) {
@@ -1559,7 +1562,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                                                       FALSE)))
                {
                    /* Can be an import stub (created by "can"). */
-                   const char * const name = (gvsv && SvPOK(gvsv)) ?  SvPVX_const(gvsv) : "???";
+                   const char * const name =
+                       (const char *)
+                       ((gvsv && SvPOK(gvsv)) ?  SvPVX_const(gvsv) : "???");
                    Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
                                "in package \"%.256s\"",
                               (GvCVGEN(gv) ? "Stub found while resolving"
diff --git a/hv.c b/hv.c
index 1643515..d1835b2 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -71,7 +71,7 @@ S_new_he(pTHX)
     LOCK_SV_MUTEX;
     if (!*root)
        S_more_he(aTHX);
-    he = *root;
+    he = (HE*) *root;
     assert(he);
     *root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
@@ -2831,12 +2831,14 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
     flags = value_type;
 
 #ifdef USE_ITHREADS
-    he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
-                             + key_len
-                             + key_offset);
+    he = (struct refcounted_he*)
+       PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+                            + key_len
+                            + key_offset);
 #else
-    he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
-                             + key_offset);
+    he = (struct refcounted_he*)
+       PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+                            + key_offset);
 #endif
 
 
index 72639dc..2ba6c41 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -484,14 +484,14 @@ Perl_huge(void)
 void
 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 {
-    gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
+    gv_fullname3(sv, gv, (const char *)(sv == (const SV*)gv ? "*" : ""));
 }
 
 /* compatibility with versions <= 5.003. */
 void
 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 {
-    gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
+    gv_efullname3(sv, gv, (const char *)(sv == (const SV*)gv ? "*" : ""));
 }
 
 void
diff --git a/mg.c b/mg.c
index 168d456..8e00fb2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -730,7 +730,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
             {
                 const int saveerrno = errno;
                 sv_setnv(sv, (NV)errno);
-                sv_setpv(sv, errno ? Strerror(errno) : "");
+                sv_setpv(sv, (const char *)(errno ? Strerror(errno) : ""));
                 errno = saveerrno;
             }
 #endif
@@ -810,11 +810,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
            }
            else if (PL_compiling.cop_warnings == pWARN_STD) {
-               sv_setpvn(
-                   sv, 
-                   (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
-                   WARNsize
-               );
+               sv_setpvn(sv,
+                         (const char *)
+                         ((PL_dowarn & G_WARN_ON) ?
+                          WARN_ALLstring : WARN_NONEstring),
+                         WARNsize);
            }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
                /* Get the bit mask for $warnings::Bits{all}, because
@@ -993,7 +993,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            sv_setpv(sv, os2error(Perl_rc));
        else
 #endif
-       sv_setpv(sv, errno ? Strerror(errno) : "");
+       sv_setpv(sv, (const char *)(errno ? Strerror(errno) : ""));
        errno = saveerrno;
        }
 #endif
@@ -1048,7 +1048,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     STRLEN len = 0, klen;
-    const char *s = SvOK(sv) ? SvPV_const(sv,len) : "";
+    const char *s = SvOK(sv) ? SvPV_const(sv,len) : (const char *)"";
     const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
@@ -1649,7 +1649,7 @@ int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
     dVAR; dSP;
-    const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+    const char * const meth = (const char *)(SvOK(key) ? "NEXTKEY" : "FIRSTKEY");
 
     ENTER;
     SAVETMPS;
@@ -2744,7 +2744,7 @@ Perl_sighandler(int sig)
 #endif
                   EXTEND(SP, 2);
                   PUSHs((SV*)rv);
-                  PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+                  PUSHs(newSVpv((char *)sip, sizeof(*sip)));
              }
 
               va_end(args);
@@ -2819,10 +2819,10 @@ S_restore_magic(pTHX_ const void *p)
            /* downgrade public flags to private,
               and discard any other private flags */
 
-           const U32 public = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
-           if (public) {
-               SvFLAGS(sv) &= ~( public | (SVp_IOK|SVp_NOK|SVp_POK) );
-               SvFLAGS(sv) |= ( public << PRIVSHIFT );
+           const U32 pubflags = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
+           if (pubflags) {
+               SvFLAGS(sv) &= ~( pubflags | (SVp_IOK|SVp_NOK|SVp_POK) );
+               SvFLAGS(sv) |= ( pubflags << PRIVSHIFT );
            }
        }
     }
diff --git a/op.c b/op.c
index 1a4ab2d..0d48328 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1875,10 +1875,12 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
          || ltype == OP_PADHV) && ckWARN(WARN_MISC))
     {
       const char * const desc
-         = PL_op_desc[(rtype == OP_SUBST || rtype == OP_TRANS)
-            ? rtype : OP_MATCH];
-      const char * const sample = ((ltype == OP_RV2AV || ltype == OP_PADAV)
-            ? "@array" : "%hash");
+         = PL_op_desc[(rtype == OP_SUBST || rtype == OP_TRANS) ?
+                      (int)rtype : OP_MATCH];
+      const char * const sample =
+         (const char *)
+         (((ltype == OP_RV2AV || ltype == OP_PADAV)
+           ? "@array" : "%hash"));
       Perl_warner(aTHX_ packWARN(WARN_MISC),
              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);
@@ -4553,7 +4555,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        loop = tmp;
     }
 #else
-    loop = PerlMemShared_realloc(loop, sizeof(LOOP));
+    loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
@@ -4574,9 +4576,10 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
-           o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-                                       ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
-                                       : ""));
+           o = newPVOP(type, 0,
+                       savepv(label->op_type == OP_CONST
+                              ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
+                              : (const char *)""));
        }
 #ifdef PERL_MAD
        op_getmad(label,o,'L');
@@ -5034,8 +5037,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        aname = NULL;
 
     gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV)
-       : gv_fetchpv(aname ? aname
-                    : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
+       : gv_fetchpv((const char *)
+                    (aname ? aname
+                     : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__")),
                     gv_fetch_flags, SVt_PVCV);
 
     if (!PL_madskills) {
@@ -5128,8 +5132,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    if (PL_copline != NOLINE)
                        CopLINE_set(PL_curcop, PL_copline);
                    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       CvCONST(cv) ? "Constant subroutine %s redefined"
-                                   : "Subroutine %s redefined", name);
+                               (const char *)
+                               (CvCONST(cv)
+                                ? "Constant subroutine %s redefined"
+                                : "Subroutine %s redefined"), name);
                    CopLINE_set(PL_curcop, oldline);
                }
 #ifdef PERL_MAD
@@ -5510,9 +5516,11 @@ CV *
 Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 {
     dVAR;
-    GV * const gv = gv_fetchpv(name ? name :
-                       (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
-                       GV_ADDMULTI, SVt_PVCV);
+    GV * const gv =
+       gv_fetchpv((const char *)
+                  (name ? name :
+                   (PL_curstash ? "__ANON__" : "__ANON__::__ANON__")),
+                   GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
     if (!subaddr)
@@ -5538,9 +5546,11 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
                            if (PL_copline != NOLINE)
                                CopLINE_set(PL_curcop, PL_copline);
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                                       CvCONST(cv) ? "Constant subroutine %s redefined"
-                                                   : "Subroutine %s redefined"
-                                       ,name);
+                                       (const char *)
+                                       (CvCONST(cv)
+                                        ? "Constant subroutine %s redefined"
+                                        : "Subroutine %s redefined"),
+                                       name);
                            CopLINE_set(PL_curcop, oldline);
                        }
                    }
@@ -5636,7 +5646,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 
 #ifdef GV_UNIQUE_CHECK
     if (GvUNIQUE(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
+        Perl_croak(aTHX_ (const char*)"Bad symbol for form (GV is unique)");
     }
 #endif
     GvMULTI_on(gv);
@@ -5646,8 +5656,10 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
            if (PL_copline != NOLINE)
                CopLINE_set(PL_curcop, PL_copline);
            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       o ? "Format %"SVf" redefined"
-                       : "Format STDOUT redefined", (void*)cSVOPo->op_sv);
+                       (const char *)
+                       (o
+                        ? "Format %"SVf" redefined"
+                        : "Format STDOUT redefined"), (void*)cSVOPo->op_sv);
            CopLINE_set(PL_curcop, oldline);
        }
        SvREFCNT_dec(cv);
@@ -6422,8 +6434,9 @@ Perl_ck_fun(pTHX_ OP *o)
                                 if (op) {
                                      SV *tmpstr = NULL;
                                      const char * const a =
-                                          kid->op_type == OP_AELEM ?
-                                          "[]" : "{}";
+                                         (const char *)
+                                         (kid->op_type == OP_AELEM ?
+                                          "[]" : "{}");
                                      if (((op->op_type == OP_RV2AV) ||
                                           (op->op_type == OP_RV2HV)) &&
                                          (firstop = ((UNOP*)op)->op_first) &&
@@ -7279,7 +7292,7 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-           const char *pmstr = re ? re->precomp : "STRING";
+           const char *pmstr = (const char *)(re ? re->precomp : "STRING");
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%s/ should probably be written as \"%s\"",
                        pmstr, pmstr);
@@ -7383,8 +7396,9 @@ Perl_ck_subr(pTHX_ OP *o)
                arg++;
                if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
                    bad_type(arg,
-                       arg == 1 ? "block or sub {}" : "sub {}",
-                       gv_ename(namegv), o3);
+                            (const char*)
+                            (arg == 1 ? "block or sub {}" : "sub {}"),
+                            gv_ename(namegv), o3);
                break;
            case '*':
                /* '*' allows any scalar type, including bareword */
diff --git a/perl.h b/perl.h
index 4f39f41..9d2611f 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5620,7 +5620,38 @@ extern void moncontrol(int);
 #include "patchlevel.h"
 #undef PERL_PATCHLEVEL_H_IMPLICIT
 
-/* Mention
+/* These are used by Perl_pv_escape() and Perl_pv_pretty() 
+ * are here so that they are available throughout the core 
+ * NOTE that even though some are for _escape and some for _pretty
+ * there must not be any clashes as the flags from _pretty are
+ * passed straight through to _escape.
+ */
+
+#define PERL_PV_ESCAPE_QUOTE        0x0001
+#define PERL_PV_PRETTY_QUOTE        PERL_PV_ESCAPE_QUOTE
+
+
+#define PERL_PV_PRETTY_ELIPSES      0x0002
+#define PERL_PV_PRETTY_LTGT         0x0004
+
+#define PERL_PV_ESCAPE_FIRSTCHAR    0x0008
+
+#define PERL_PV_ESCAPE_UNI          0x0100     
+#define PERL_PV_ESCAPE_UNI_DETECT   0x0200
+
+#define PERL_PV_ESCAPE_ALL         0x1000
+#define PERL_PV_ESCAPE_NOBACKSLASH  0x2000
+#define PERL_PV_ESCAPE_NOCLEAR      0x4000
+
+/* used by pv_display in dump.c*/
+#define PERL_PV_PRETTY_DUMP  PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_QUOTE
+#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT
+
+/*
+
+   (KEEP THIS LAST IN perl.h!)
+
+   Mention
 
    NV_PRESERVES_UV
 
@@ -5660,34 +5691,11 @@ extern void moncontrol(int);
 
    HAS_DIRFD
 
-   so that Configure picks them up. */
-
-/* These are used by Perl_pv_escape() and Perl_pv_pretty() 
- * are here so that they are available throughout the core 
- * NOTE that even though some are for _escape and some for _pretty
- * there must not be any clashes as the flags from _pretty are
- * passed straight through to _escape.
- */
-
-#define PERL_PV_ESCAPE_QUOTE        0x0001
-#define PERL_PV_PRETTY_QUOTE        PERL_PV_ESCAPE_QUOTE
-
-
-#define PERL_PV_PRETTY_ELIPSES      0x0002
-#define PERL_PV_PRETTY_LTGT         0x0004
-
-#define PERL_PV_ESCAPE_FIRSTCHAR    0x0008
-
-#define PERL_PV_ESCAPE_UNI          0x0100     
-#define PERL_PV_ESCAPE_UNI_DETECT   0x0200
+   so that Configure picks them up.
 
-#define PERL_PV_ESCAPE_ALL         0x1000
-#define PERL_PV_ESCAPE_NOBACKSLASH  0x2000
-#define PERL_PV_ESCAPE_NOCLEAR      0x4000
+   (KEEP THIS LAST IN perl.h!)
 
-/* used by pv_display in dump.c*/
-#define PERL_PV_PRETTY_DUMP  PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_QUOTE
-#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT
+*/
 
 #endif /* Include guard */
 
index 817026f..7d8c5e0 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2266,8 +2266,8 @@ S_more_refcounted_fds(pTHX_ const int new_fd) {
 
     assert (new_max > new_fd);
 
-    new_array
-       = PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+    new_array =
+       (int*) PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
 
     if (!new_array) {
 #ifdef USE_THREADS
index 1f9fa4a..acc7d57 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -796,17 +796,23 @@ PP(pp_formline)
        case FF_0DECIMAL:
            arg = *fpc++;
 #if defined(USE_LONG_DOUBLE)
-           fmt = (arg & 256) ? "%#0*.*" PERL_PRIfldbl : "%0*.*" PERL_PRIfldbl;
+           fmt = (const char *)
+               ((arg & 256) ?
+                "%#0*.*" PERL_PRIfldbl : "%0*.*" PERL_PRIfldbl);
 #else
-           fmt = (arg & 256) ? "%#0*.*f"              : "%0*.*f";
+           fmt = (const char *)
+               ((arg & 256) ?
+                "%#0*.*f"              : "%0*.*f");
 #endif
            goto ff_dec;
        case FF_DECIMAL:
            arg = *fpc++;
 #if defined(USE_LONG_DOUBLE)
-           fmt = (arg & 256) ? "%#*.*" PERL_PRIfldbl : "%*.*" PERL_PRIfldbl;
+           fmt = (const char *)
+               ((arg & 256) ? "%#*.*" PERL_PRIfldbl : "%*.*" PERL_PRIfldbl);
 #else
-            fmt = (arg & 256) ? "%#*.*f"              : "%*.*f";
+            fmt = (const char *)
+               ((arg & 256) ? "%#*.*f"              : "%*.*f");
 #endif
        ff_dec:
            /* If the field is marked with ^ and the value is undefined,
@@ -1509,7 +1515,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
            if (CxTYPE(cx) != CXt_EVAL) {
                if (!message)
                    message = SvPVx_const(ERRSV, msglen);
-               PerlIO_write(Perl_error_log, "panic: die ", 11);
+               PerlIO_write(Perl_error_log, (const char *)"panic: die ", 11);
                PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
            }
@@ -1731,7 +1737,7 @@ PP(pp_reset)
 {
     dVAR;
     dSP;
-    const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
+    const char * const tmps = (MAXARG < 1) ? (const char *)"" : POPpconstx;
     sv_reset(tmps, CopSTASH(PL_curcop));
     PUSHs(&PL_sv_yes);
     RETURN;
@@ -3774,39 +3780,39 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     
     SV *e = TOPs;      /* e is for 'expression' */
     SV *d = TOPm1s;    /* d is for 'default', as in PL_defgv */
-    SV *this, *other;
+    SV *This, *Other;  /* 'This' (and Other to match) to play with C++ */
     MAGIC *mg;
     regexp *this_regex, *other_regex;
 
 #   define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
 
 #   define SM_REF(type) ( \
-          (SvROK(d) && (SvTYPE(this = SvRV(d)) == SVt_##type) && (other = e)) \
-       || (SvROK(e) && (SvTYPE(this = SvRV(e)) == SVt_##type) && (other = d)))
+          (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_##type) && (Other = e)) \
+       || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_##type) && (Other = d)))
 
 #   define SM_CV_NEP   /* Find a code ref without an empty prototype */ \
-       ((SvROK(d) && (SvTYPE(this = SvRV(d)) == SVt_PVCV)              \
-           && NOT_EMPTY_PROTO(this) && (other = e))                    \
-       || (SvROK(e) && (SvTYPE(this = SvRV(e)) == SVt_PVCV)            \
-           && NOT_EMPTY_PROTO(this) && (other = d)))
+       ((SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_PVCV)              \
+           && NOT_EMPTY_PROTO(This) && (Other = e))                    \
+       || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_PVCV)            \
+           && NOT_EMPTY_PROTO(This) && (Other = d)))
 
 #   define SM_REGEX ( \
-          (SvROK(d) && SvMAGICAL(this = SvRV(d))                       \
-       && (mg = mg_find(this, PERL_MAGIC_qr))                          \
+          (SvROK(d) && SvMAGICAL(This = SvRV(d))                       \
+       && (mg = mg_find(This, PERL_MAGIC_qr))                          \
        && (this_regex = (regexp *)mg->mg_obj)                          \
-       && (other = e))                                                 \
+       && (Other = e))                                                 \
     ||                                                                 \
-          (SvROK(e) && SvMAGICAL(this = SvRV(e))                       \
-       && (mg = mg_find(this, PERL_MAGIC_qr))                          \
+          (SvROK(e) && SvMAGICAL(This = SvRV(e))                       \
+       && (mg = mg_find(This, PERL_MAGIC_qr))                          \
        && (this_regex = (regexp *)mg->mg_obj)                          \
-       && (other = d)) )
+       && (Other = d)) )
        
 
 #   define SM_OTHER_REF(type) \
-       (SvROK(other) && SvTYPE(SvRV(other)) == SVt_##type)
+       (SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
 
-#   define SM_OTHER_REGEX (SvROK(other) && SvMAGICAL(SvRV(other))      \
-       && (mg = mg_find(SvRV(other), PERL_MAGIC_qr))                   \
+#   define SM_OTHER_REGEX (SvROK(Other) && SvMAGICAL(SvRV(Other))      \
+       && (mg = mg_find(SvRV(Other), PERL_MAGIC_qr))                   \
        && (other_regex = (regexp *)mg->mg_obj))
        
 
@@ -3836,9 +3842,9 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     if (SM_CV_NEP) {
        I32 c;
        
-       if ( SM_OTHER_REF(PVCV) && NOT_EMPTY_PROTO(SvRV(other)) )
+       if ( SM_OTHER_REF(PVCV) && NOT_EMPTY_PROTO(SvRV(Other)) )
        {
-           if (this == SvRV(other))
+           if (This == SvRV(Other))
                RETPUSHYES;
            else
                RETPUSHNO;
@@ -3847,9 +3853,9 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
-       PUSHs(other);
+       PUSHs(Other);
        PUTBACK;
-       c = call_sv(this, G_SCALAR);
+       c = call_sv(This, G_SCALAR);
        SPAGAIN;
        if (c == 0)
            PUSHs(&PL_sv_no);
@@ -3863,39 +3869,39 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        if (SM_OTHER_REF(PVHV)) {
            /* Check that the key-sets are identical */
            HE *he;
-           HV *other_hv = (HV *) SvRV(other);
+           HV *other_hv = (HV *) SvRV(Other);
            bool tied = FALSE;
            bool other_tied = FALSE;
            U32 this_key_count  = 0,
                other_key_count = 0;
            
            /* Tied hashes don't know how many keys they have. */
-           if (SvTIED_mg(this, PERL_MAGIC_tied)) {
+           if (SvTIED_mg(This, PERL_MAGIC_tied)) {
                tied = TRUE;
            }
            else if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied)) {
                HV * const temp = other_hv;
-               other_hv = (HV *) this;
-               this  = (SV *) temp;
+               other_hv = (HV *) This;
+               This  = (SV *) temp;
                tied = TRUE;
            }
            if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied))
                other_tied = TRUE;
            
-           if (!tied && HvUSEDKEYS((HV *) this) != HvUSEDKEYS(other_hv))
+           if (!tied && HvUSEDKEYS((HV *) This) != HvUSEDKEYS(other_hv))
                RETPUSHNO;
 
            /* The hashes have the same number of keys, so it suffices
               to check that one is a subset of the other. */
-           (void) hv_iterinit((HV *) this);
-           while ( (he = hv_iternext((HV *) this)) ) {
+           (void) hv_iterinit((HV *) This);
+           while ( (he = hv_iternext((HV *) This)) ) {
                I32 key_len;
                char * const key = hv_iterkey(he, &key_len);
                
                ++ this_key_count;
                
                if(!hv_exists(other_hv, key, key_len)) {
-                   (void) hv_iterinit((HV *) this);    /* reset iterator */
+                   (void) hv_iterinit((HV *) This);    /* reset iterator */
                    RETPUSHNO;
                }
            }
@@ -3914,11 +3920,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                RETPUSHYES;
        }
        else if (SM_OTHER_REF(PVAV)) {
-           AV * const other_av = (AV *) SvRV(other);
+           AV * const other_av = (AV *) SvRV(Other);
            const I32 other_len = av_len(other_av) + 1;
            I32 i;
            
-           if (HvUSEDKEYS((HV *) this) != other_len)
+           if (HvUSEDKEYS((HV *) This) != other_len)
                RETPUSHNO;
            
            for(i = 0; i < other_len; ++i) {
@@ -3930,7 +3936,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                    RETPUSHNO;
 
                key = SvPV(*svp, key_len);
-               if(!hv_exists((HV *) this, key, key_len))
+               if(!hv_exists((HV *) This, key, key_len))
                    RETPUSHNO;
            }
            RETPUSHYES;
@@ -3939,10 +3945,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            PMOP * const matcher = make_matcher(other_regex);
            HE *he;
 
-           (void) hv_iterinit((HV *) this);
-           while ( (he = hv_iternext((HV *) this)) ) {
+           (void) hv_iterinit((HV *) This);
+           while ( (he = hv_iternext((HV *) This)) ) {
                if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
-                   (void) hv_iterinit((HV *) this);
+                   (void) hv_iterinit((HV *) This);
                    destroy_matcher(matcher);
                    RETPUSHYES;
                }
@@ -3951,7 +3957,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHNO;
        }
        else {
-           if (hv_exists_ent((HV *) this, other, 0))
+           if (hv_exists_ent((HV *) This, Other, 0))
                RETPUSHYES;
            else
                RETPUSHNO;
@@ -3959,8 +3965,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     }
     else if (SM_REF(PVAV)) {
        if (SM_OTHER_REF(PVAV)) {
-           AV *other_av = (AV *) SvRV(other);
-           if (av_len((AV *) this) != av_len(other_av))
+           AV *other_av = (AV *) SvRV(Other);
+           if (av_len((AV *) This) != av_len(other_av))
                RETPUSHNO;
            else {
                I32 i;
@@ -3975,7 +3981,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                    (void) sv_2mortal((SV *) seen_other);
                }
                for(i = 0; i <= other_len; ++i) {
-                   SV * const * const this_elem = av_fetch((AV *)this, i, FALSE);
+                   SV * const * const this_elem = av_fetch((AV *)This, i, FALSE);
                    SV * const * const other_elem = av_fetch(other_av, i, FALSE);
 
                    if (!this_elem || !other_elem) {
@@ -4011,11 +4017,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        }
        else if (SM_OTHER_REGEX) {
            PMOP * const matcher = make_matcher(other_regex);
-           const I32 this_len = av_len((AV *) this);
+           const I32 this_len = av_len((AV *) This);
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
                if (svp && matcher_matches_sv(matcher, *svp)) {
                    destroy_matcher(matcher);
                    RETPUSHYES;
@@ -4024,15 +4030,15 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            destroy_matcher(matcher);
            RETPUSHNO;
        }
-       else if (SvIOK(other) || SvNOK(other)) {
+       else if (SvIOK(Other) || SvNOK(Other)) {
            I32 i;
 
-           for(i = 0; i <= AvFILL((AV *) this); ++i) {
-               SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+           for(i = 0; i <= AvFILL((AV *) This); ++i) {
+               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
                if (!svp)
                    continue;
                
-               PUSHs(other);
+               PUSHs(Other);
                PUSHs(*svp);
                PUTBACK;
                if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
@@ -4045,16 +4051,16 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            }
            RETPUSHNO;
        }
-       else if (SvPOK(other)) {
-           const I32 this_len = av_len((AV *) this);
+       else if (SvPOK(Other)) {
+           const I32 this_len = av_len((AV *) This);
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
                if (!svp)
                    continue;
                
-               PUSHs(other);
+               PUSHs(Other);
                PUSHs(*svp);
                PUTBACK;
                (void) pp_seq();
@@ -4075,7 +4081,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        PMOP * const matcher = make_matcher(this_regex);
 
        PUTBACK;
-       PUSHs(matcher_matches_sv(matcher, other)
+       PUSHs(matcher_matches_sv(matcher, Other)
            ? &PL_sv_yes
            : &PL_sv_no);
        destroy_matcher(matcher);
@@ -4090,7 +4096,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        SAVETMPS;
        PUSHMARK(SP);
        PUTBACK;
-       c = call_sv(this, G_SCALAR);
+       c = call_sv(This, G_SCALAR);
        SPAGAIN;
        if (c == 0)
            PUSHs(&PL_sv_undef);
@@ -4101,7 +4107,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            /* This one has to be null-proto'd too.
               Call both of 'em, and compare the results */
            PUSHMARK(SP);
-           c = call_sv(SvRV(other), G_SCALAR);
+           c = call_sv(SvRV(Other), G_SCALAR);
            SPAGAIN;
            if (c == 0)
                PUSHs(&PL_sv_undef);
@@ -4117,10 +4123,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        LEAVE;
        RETURN;
     }
-    else if ( ((SvIOK(d) || SvNOK(d)) && (this = d) && (other = e))
-         ||   ((SvIOK(e) || SvNOK(e)) && (this = e) && (other = d)) )
+    else if ( ((SvIOK(d) || SvNOK(d)) && (This = d) && (Other = e))
+         ||   ((SvIOK(e) || SvNOK(e)) && (This = e) && (Other = d)) )
     {
-       if (SvPOK(other) && !looks_like_number(other)) {
+       if (SvPOK(Other) && !looks_like_number(Other)) {
            /* String comparison */
            PUSHs(d); PUSHs(e);
            PUTBACK;
@@ -4529,7 +4535,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
                    take = umaxlen;
                }
            } else {
-               const char *const first_nl = memchr(cache_p, '\n', cache_len);
+               const char *const first_nl =
+                   (const char *)memchr(cache_p, '\n', cache_len);
                if (first_nl) {
                    take = first_nl + 1 - cache_p;
                }
@@ -4601,7 +4608,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
                prune_from = got_p + umaxlen;
            }
        } else {
-           const char *const first_nl = memchr(got_p, '\n', got_len);
+           const char *const first_nl =
+               (const char *)memchr(got_p, '\n', got_len);
            if (first_nl && first_nl + 1 < got_p + got_len) {
                /* There's a second line here... */
                prune_from = first_nl + 1;
index 498d508..aa792bf 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1937,7 +1937,9 @@ PP(pp_iter)
            /* string increment */
            register SV* cur = cx->blk_loop.iterlval;
            STRLEN maxlen = 0;
-           const char *max = SvOK((SV*)av) ? SvPV_const((SV*)av, maxlen) : "";
+           const char *max =
+             SvOK((SV*)av) ?
+             SvPV_const((SV*)av, maxlen) : (const char *)"";
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
index b593e30..f155e34 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -62,7 +62,7 @@ typedef struct tempsym {
        (symptr)->grpend   = NULL;      \
        (symptr)->code     = 0;         \
        (symptr)->length   = 0;         \
-       (symptr)->howlen   = 0;         \
+       (symptr)->howlen   = e_no_len;  \
        (symptr)->level    = 0;         \
        (symptr)->flags    = (f);       \
        (symptr)->strbeg   = 0;         \
@@ -776,7 +776,7 @@ STMT_START {                                                        \
 
 static const char *_action( const tempsym_t* symptr )
 {
-    return ( symptr->flags & FLAG_PACK ) ? "pack" : "unpack";
+    return (const char *)(( symptr->flags & FLAG_PACK ) ? "pack" : "unpack");
 }
 
 /* Returns the sizeof() struct described by pat */
@@ -2088,7 +2088,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
              * algorithm, the code will be character-set independent
              * (and just as fast as doing character arithmetic)
              */
-            if (PL_uudmap['M'] == 0) {
+            if (PL_uudmap[(U8)'M'] == 0) {
                size_t i;
 
                for (i = 0; i < sizeof(PL_uuemap); ++i)
@@ -2097,7 +2097,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                  * Because ' ' and '`' map to the same value,
                  * we need to decode them both the same.
                  */
-                PL_uudmap[' '] = 0;
+                PL_uudmap[(U8)' '] = 0;
             }
            {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
index 690bc9d..9068b0e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1270,6 +1270,7 @@ PP(pp_enterwrite)
     register IO *io;
     GV *fgv;
     CV *cv;
+    SV * tmpsv = NULL;
 
     if (MAXARG == 0)
        gv = PL_defoutgv;
@@ -1293,8 +1294,8 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
-       SV * const tmpsv = sv_newmortal();
        const char *name;
+       tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
        name = SvPV_nolen_const(tmpsv);
        if (name && *name)
@@ -1622,7 +1623,7 @@ PP(pp_sysread)
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */
        count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
-                         (struct sockaddr *)namebuf, &bufsize);
+                                 (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
 #ifdef EPOC
@@ -2785,7 +2786,7 @@ PP(pp_stat)
 {
     dVAR;
     dSP;
-    GV *gv;
+    GV *gv = NULL;
     IO *io;
     I32 gimme;
     I32 max = 13;
@@ -4650,7 +4651,7 @@ PP(pp_ghostent)
        STRLEN addrlen;
        Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen);
 
-       hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+       hent = PerlSock_gethostbyaddr((const void*)addr, (Netdb_hlen_t) addrlen, addrtype);
 #else
        DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
 #endif
diff --git a/proto.h b/proto.h
index 8f9bfa4..b73bd70 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3873,13 +3873,6 @@ STATIC PTR_TBL_ENT_t *   S_ptr_table_find(PTR_TBL_t *tbl, const void *sv)
                        __attribute__nonnull__(2);
 
 #  endif
-STATIC SV *    S_find_hash_subscript(pTHX_ HV *hv, SV *val)
-                       __attribute__nonnull__(pTHX_2);
-
-STATIC I32     S_find_array_subscript(pTHX_ AV *av, SV *val)
-                       __attribute__nonnull__(pTHX_2);
-
-STATIC SV *    S_find_uninit_var(pTHX_ OP *obase, SV *uninit_sv, bool match);
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
@@ -4270,7 +4263,14 @@ PERL_CALLCONV SV*        Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-#ifdef PERL_IN_SV_C
+
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
+STATIC SV *    S_find_hash_subscript(pTHX_ HV *hv, SV *val)
+                       __attribute__nonnull__(pTHX_2);
+
+STATIC I32     S_find_array_subscript(pTHX_ AV *av, SV *val)
+                       __attribute__nonnull__(pTHX_2);
+
 STATIC SV*     S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool top);
 #endif
 
index 8928c41..c26677a 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -512,7 +512,7 @@ S_cl_is_anything(const struct regnode_charclass_class *cl)
            return 1;
     if (!(cl->flags & ANYOF_UNICODE_ALL))
        return 0;
-    if (!ANYOF_BITMAP_TESTALLSET(cl))
+    if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
        return 0;
     return 1;
 }
@@ -2502,7 +2502,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
        }
 #ifdef TRIE_STUDY_OPT  
        else if (OP(scan) == TRIE) {
-           reg_trie_data *trie=RExC_rx->data->data[ ARG(scan) ];
+           reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
            min += trie->minlen;
            delta += (trie->maxlen - trie->minlen);
            flags &= ~SCF_DO_STCLASS; /* xxx */
@@ -4297,6 +4297,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     I32 min;
     I32 max = REG_INFTY;
     char *parse_start;
+    const char *maxpos = NULL;
     GET_RE_DEBUG_FLAGS_DECL;
     DEBUG_PARSE("piec");
 
@@ -4310,7 +4311,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     op = *RExC_parse;
 
     if (op == '{' && regcurly(RExC_parse)) {
-       const char *maxpos = NULL;
+       maxpos = NULL;
         parse_start = RExC_parse; /* MJD */
        next = RExC_parse + 1;
        while (isDIGIT(*next) || *next == ',') {
@@ -6411,9 +6412,10 @@ Perl_regdump(pTHX_ const regexp *r)
     }
     if (r->check_substr || r->check_utf8)
        PerlIO_printf(Perl_debug_log,
-                     r->check_substr == r->float_substr
-                     && r->check_utf8 == r->float_utf8
-                     ? "(checking floating" : "(checking anchored");
+                     (const char *)
+                     (r->check_substr == r->float_substr
+                      && r->check_utf8 == r->float_utf8
+                      ? "(checking floating" : "(checking anchored"));
     if (r->reganch & ROPT_NOSCAN)
        PerlIO_printf(Perl_debug_log, " noscan");
     if (r->reganch & ROPT_CHECK_ALL)
index ac55c82..3731b60 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2389,6 +2389,8 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                                                            subpattern */
     U32 state_num;
     
+    I32 parenfloor = 0;
+
 #ifdef DEBUGGING
     GET_RE_DEBUG_FLAGS_DECL;
     PL_regindent++;
@@ -3406,8 +3408,8 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
        case CURLYX: {
                /* No need to save/restore up to this paren */
-               I32 parenfloor = scan->flags;
-
+               parenfloor = scan->flags;
+               
                /* Dave says:
                   
                   CURLYX and WHILEM are always paired: they're the moral
diff --git a/scope.c b/scope.c
index 58beb73..a2a0f3a 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -980,7 +980,7 @@ Perl_leave_scope(pTHX_ I32 base)
            if (!specialWARN(PL_compiling.cop_warnings))
                PerlMemShared_free(PL_compiling.cop_warnings);
 
-           PL_compiling.cop_warnings = ptr;
+           PL_compiling.cop_warnings = (STRLEN*)ptr;
            break;
        case SAVEt_RE_STATE:
            {
diff --git a/sv.c b/sv.c
index 065a292..146d9e7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1450,10 +1450,10 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
                return s;
            } else
 #endif
-           s = saferealloc(s, newlen);
+           s = (char*)saferealloc(s, newlen);
        }
        else {
-           s = safemalloc(newlen);
+           s = (char*)safemalloc(newlen);
            if (SvPVX_const(sv) && SvCUR(sv)) {
                Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
            }
@@ -2688,7 +2688,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                s = SvGROW_mutable(sv, len + 1);
                SvCUR_set(sv, len);
                SvPOKp_on(sv);
-               return memcpy(s, tbuf, len + 1);
+               return (char*)memcpy(s, tbuf, len + 1);
            }
        }
         if (SvROK(sv)) {
@@ -3317,9 +3317,10 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
                                         || sv_cmp(cv_const_sv(cv),
                                                   cv_const_sv((CV*)sref))))) {
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                                       CvCONST(cv)
-                                       ? "Constant subroutine %s::%s redefined"
-                                       : "Subroutine %s::%s redefined",
+                                       (const char *)
+                                       (CvCONST(cv)
+                                        ? "Constant subroutine %s::%s redefined"
+                                        : "Subroutine %s::%s redefined"),
                                        HvNAME_get(GvSTASH((GV*)dstr)),
                                        GvENAME((GV*)dstr));
                        }
@@ -3950,13 +3951,13 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     } else {
 #ifdef DEBUGGING
        /* Force a move to shake out bugs in callers.  */
-       char *new_ptr = safemalloc(allocate);
+       char *new_ptr = (char*)safemalloc(allocate);
        Copy(ptr, new_ptr, len, char);
        PoisonFree(ptr,len,char);
        Safefree(ptr);
        ptr = new_ptr;
 #else
-       ptr = saferealloc (ptr, allocate);
+       ptr = (char*) saferealloc (ptr, allocate);
 #endif
     }
     SvPV_set(sv, ptr);
diff --git a/toke.c b/toke.c
index b3688bb..03bc682 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1791,9 +1791,10 @@ S_scan_const(pTHX_ char *start)
 #endif
 
     const char * const leaveit = /* set of acceptably-backslashed characters */
-       PL_lex_inpat
-           ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
-           : "";
+       (const char *)
+       (PL_lex_inpat
+        ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
+        : "");
 
     if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
        /* If we are doing a trans and we know we want UTF8 set expectation */
@@ -2352,13 +2353,15 @@ S_scan_const(pTHX_ char *start)
     /* return the substring (via yylval) only if we parsed anything */
     if (s > PL_bufptr) {
        if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
-           sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
+           sv = new_constant(start, s - start,
+                             (const char *)(PL_lex_inpat ? "qr" : "q"),
                              sv, NULL,
-                             ( PL_lex_inwhat == OP_TRANS
-                               ? "tr"
-                               : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
-                                   ? "s"
-                                   : "qq")));
+                             (const char *)
+                             (( PL_lex_inwhat == OP_TRANS
+                                ? "tr"
+                                : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
+                                    ? "s"
+                                    : "qq"))));
        yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
     } else
        SvREFCNT_dec(sv);
@@ -2473,7 +2476,7 @@ S_intuit_more(pTHX_ register char *s)
                if (s[1]) {
                    if (strchr("wds]",s[1]))
                        weight += 100;
-                   else if (seen['\''] || seen['"'])
+                   else if (seen[(U8)'\''] || seen[(U8)'"'])
                        weight += 1;
                    else if (strchr("rnftbxcav",s[1]))
                        weight += 40;
@@ -3095,6 +3098,13 @@ Perl_yylex(pTHX)
     STRLEN len;
     bool bof = FALSE;
 
+    /* orig_keyword, gvp, and gv are initialized here because
+     * jump to the label just_a_word_zero can bypass their
+     * initialization later. */
+    I32 orig_keyword = 0;
+    GV *gv = NULL;
+    GV **gvp = NULL;
+
     DEBUG_T( {
        SV* tmp = newSVpvs("");
        PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n",
@@ -3432,9 +3442,10 @@ Perl_yylex(pTHX)
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets) {
-               yyerror(PL_lex_formbrack
-                   ? "Format not terminated"
-                   : "Missing right curly or square bracket");
+               yyerror((const char *)
+                       (PL_lex_formbrack
+                        ? "Format not terminated"
+                        : "Missing right curly or square bracket"));
            }
             DEBUG_T( { PerlIO_printf(Perl_debug_log,
                         "### Tokener got EOF\n");
@@ -3534,8 +3545,10 @@ Perl_yylex(pTHX)
                    if (PL_madskills)
                        PL_faketokens = 1;
 #endif
-                   sv_setpv(PL_linestr,PL_minus_p
-                            ? ";}continue{print;}" : ";}");
+                   sv_setpv(PL_linestr,
+                            (const char *)
+                            (PL_minus_p
+                             ? ";}continue{print;}" : ";}"));
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
@@ -4206,10 +4219,11 @@ Perl_yylex(pTHX)
                       context messages from yyerror().
                    */
                    PL_bufptr = s;
-                   yyerror( *s
-                            ? Perl_form(aTHX_ "Invalid separator character "
-                                        "%c%c%c in attribute list", q, *s, q)
-                            : "Unterminated attribute list" );
+                   yyerror( (const char *)
+                            (*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(':');
@@ -5015,9 +5029,10 @@ Perl_yylex(pTHX)
 
       keylookup: {
        I32 tmp;
-       I32 orig_keyword = 0;
-       GV *gv = NULL;
-       GV **gvp = NULL;
+
+       orig_keyword = 0;
+       gv = NULL;
+       gvp = NULL;
 
        PL_bufptr = s;
        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
@@ -5394,8 +5409,10 @@ Perl_yylex(pTHX)
                        while (*proto == ';')
                            proto++;
                        if (*proto == '&' && *s == '{') {
-                           sv_setpv(PL_subname, PL_curstash ?
-                                       "__ANON__" : "__ANON__::__ANON__");
+                           sv_setpv(PL_subname,
+                                    (const char *)
+                                    (PL_curstash ?
+                                     "__ANON__" : "__ANON__::__ANON__"));
                            PREBLOCK(LSTOPSUB);
                        }
                    }
@@ -6623,7 +6640,8 @@ Perl_yylex(pTHX)
 #endif
                if (!have_name) {
                    sv_setpv(PL_subname,
-                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__");
+                            (const char *)
+                            (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"));
                    TOKEN(ANONSUB);
                }
 #ifndef PERL_MAD
@@ -10374,9 +10392,10 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
-       why2 = strEQ(key,"charnames")
-              ? "(possibly a missing \"use charnames ...\")"
-              : "";
+       why2 = (const char *)
+           (strEQ(key,"charnames")
+            ? "(possibly a missing \"use charnames ...\")"
+            : "");
        msg = Perl_newSVpvf(aTHX_ "Constant(%s) unknown: %s",
                            (type ? type: "undef"), why2);
 
@@ -10604,7 +10623,9 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
                s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
-                   const char * const brack = (*s == '[') ? "[...]" : "{...}";
+                   const char * const brack =
+                       (const char *)
+                       ((*s == '[') ? "[...]" : "{...}");
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                        "Ambiguous use of %c{%s%s} resolved to %c%s%s",
                        funny, dest, brack, funny, dest, brack);
@@ -10681,7 +10702,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     dVAR;
     PMOP *pm;
     char *s = scan_str(start,!!PL_madskills,FALSE);
-    const char * const valid_flags = (type == OP_QR) ? "iomsx" : "iogcmsx";
+    const char * const valid_flags =
+       (const char *)((type == OP_QR) ? "iomsx" : "iogcmsx");
 #ifdef PERL_MAD
     char *modstart;
 #endif
@@ -10689,9 +10711,11 @@ S_scan_pat(pTHX_ char *start, I32 type)
 
     if (!s) {
        const char * const delimiter = skipspace(start);
-       Perl_croak(aTHX_ *delimiter == '?'
-                  ? "Search pattern not terminated or ternary operator parsed as search pattern"
-                  : "Search pattern not terminated" );
+       Perl_croak(aTHX_
+                  (const char *)
+                  (*delimiter == '?'
+                   ? "Search pattern not terminated or ternary operator parsed as search pattern"
+                   : "Search pattern not terminated" ));
     }
 
     pm = (PMOP*)newPMOP(type, 0);
@@ -10806,7 +10830,7 @@ S_scan_subst(pTHX_ char *start)
        PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
        while (es-- > 0)
-           sv_catpv(repl, es ? "eval " : "do ");
+           sv_catpv(repl, (const char *)(es ? "eval " : "do "));
        sv_catpvs(repl, "{");
        sv_catsv(repl, PL_lex_repl);
        if (strchr(SvPVX(PL_lex_repl), '#'))
@@ -11004,7 +11028,7 @@ S_scan_heredoc(pTHX_ register char *s)
 #ifdef PERL_MAD
     found_newline = 0;
 #endif
-    if ( outer || !(found_newline = memchr(s, '\n', PL_bufend - s)) ) {
+    if ( outer || !(found_newline = (char*)memchr((void*)s, '\n', PL_bufend - s)) ) {
         herewas = newSVpvn(s,PL_bufend-s);
     }
     else {
@@ -12100,7 +12124,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
                       (PL_hints & HINT_NEW_INTEGER) )
-           sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
+           sv = new_constant(PL_tokenbuf,
+                             d - PL_tokenbuf,
+                             (const char *)
                              (floatit ? "float" : "integer"),
                              sv, NULL, NULL);
        break;
diff --git a/utf8.c b/utf8.c
index 28ac605..21be126 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -524,7 +524,7 @@ malformed:
 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)
-           *retlen = -1;
+           *retlen = ((STRLEN) -1);
        return 0;
     }
 
@@ -653,6 +653,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 {
     dVAR;
     STRLEN len = 0;
+    U8 t = 0;
 
     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g.
      * the bitops (especially ~) can create illegal UTF-8.
@@ -661,7 +662,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
     if (e < s)
        goto warn_and_return;
     while (s < e) {
-       const U8 t = UTF8SKIP(s);
+       t = UTF8SKIP(s);
        if (e - s < t) {
            warn_and_return:
            if (ckWARN_d(WARN_UTF8)) {
@@ -760,7 +761,7 @@ Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
         if (!UTF8_IS_INVARIANT(c) &&
             (!UTF8_IS_DOWNGRADEABLE_START(c) || (s >= send)
             || !(c = *s++) || !UTF8_IS_CONTINUATION(c))) {
-            *len = -1;
+            *len = ((STRLEN) -1);
             return 0;
         }
     }
diff --git a/util.c b/util.c
index bb2eab7..7a89c5c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -882,8 +882,8 @@ Perl_savepv(pTHX_ const char *pv)
     else {
        char *newaddr;
        const STRLEN pvlen = strlen(pv)+1;
-       Newx(newaddr,pvlen,char);
-       return memcpy(newaddr,pv,pvlen);
+       Newx(newaddr, pvlen, char);
+       return (char*)memcpy(newaddr, pv, pvlen);
     }
 }
 
@@ -939,7 +939,7 @@ Perl_savesharedpv(pTHX_ const char *pv)
     if (!newaddr) {
        return write_no_mem();
     }
-    return memcpy(newaddr,pv,pvlen);
+    return (char*)memcpy(newaddr, pv, pvlen);
 }
 
 /*
@@ -1537,8 +1537,10 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
     const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
     PERL_UNUSED_CONTEXT;
 
-    buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
-       : PerlMemShared_realloc(buffer, len_wanted);
+    buffer = (STRLEN*)
+       (specialWARN(buffer) ?
+        PerlMemShared_malloc(len_wanted) :
+        PerlMemShared_realloc(buffer, len_wanted));
     buffer[0] = size;
     Copy(bits, (buffer + 1), size, char);
     return buffer;
@@ -3434,7 +3436,8 @@ Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 
     if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
        if (ckWARN(WARN_IO)) {
-           const char * const direction = (op == OP_phoney_INPUT_ONLY) ? "in" : "out";
+           const char * const direction =
+               (const char *)((op == OP_phoney_INPUT_ONLY) ? "in" : "out");
            if (name && *name)
                Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Filehandle %s opened only for %sput",
@@ -3458,15 +3461,19 @@ Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
        }
 
        if (ckWARN(warn_type)) {
-           const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+           const char * const pars =
+               (const char *)(OP_IS_FILETEST(op) ? "" : "()");
            const char * const func =
-               op == OP_READLINE   ? "readline"  :     /* "<HANDLE>" not nice */
-               op == OP_LEAVEWRITE ? "write" :         /* "write exit" not nice */
-               op < 0              ? "" :              /* handle phoney cases */
-               PL_op_desc[op];
-           const char * const type = OP_IS_SOCKET(op)
-                   || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
-                       ?  "socket" : "filehandle";
+               (const char *)
+               (op == OP_READLINE   ? "readline"  :    /* "<HANDLE>" not nice */
+                op == OP_LEAVEWRITE ? "write" :                /* "write exit" not nice */
+                op < 0              ? "" :              /* handle phoney cases */
+                PL_op_desc[op]);
+           const char * const type =
+               (const char *)
+               (OP_IS_SOCKET(op) ||
+                (gv && io && IoTYPE(io) == IoTYPE_SOCKET) ?
+                "socket" : "filehandle");
            if (name && *name) {
                Perl_warner(aTHX_ packWARN(warn_type),
                            "%s%s on %s %s %s", func, pars, vile, type, name);
index 423a21a..9c84c25 100644 (file)
@@ -92,8 +92,8 @@
 #define isWARNf_on(c,x)        (IsSet((U8 *)(c + 1), 2*(x)+1))
 
 #define DUP_WARNINGS(p)                \
-    specialWARN(p) ? (p)       \
-    : CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, char)
+    (STRLEN*)(specialWARN(p) ? (p)     \
+    : CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, char))
 
 #define ckWARN(w)              Perl_ckwarn(aTHX_ packWARN(w))
 #define ckWARN2(w1,w2)         Perl_ckwarn(aTHX_ packWARN2(w1,w2))