diff options
| -rwxr-xr-x | cflags.SH | 12 | ||||
| -rw-r--r-- | deb.c | 4 | ||||
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | embed.fnc | 8 | ||||
| -rw-r--r-- | embed.h | 18 | ||||
| -rw-r--r-- | gv.c | 25 | ||||
| -rw-r--r-- | hv.c | 14 | ||||
| -rw-r--r-- | mathoms.c | 4 | ||||
| -rw-r--r-- | mg.c | 28 | ||||
| -rw-r--r-- | op.c | 66 | ||||
| -rw-r--r-- | perl.h | 62 | ||||
| -rw-r--r-- | perlio.c | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 132 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | pp_pack.c | 8 | ||||
| -rw-r--r-- | pp_sys.c | 9 | ||||
| -rw-r--r-- | proto.h | 16 | ||||
| -rw-r--r-- | regcomp.c | 14 | ||||
| -rw-r--r-- | regexec.c | 6 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 17 | ||||
| -rw-r--r-- | toke.c | 98 | ||||
| -rw-r--r-- | utf8.c | 7 | ||||
| -rw-r--r-- | util.c | 35 | ||||
| -rw-r--r-- | warnings.h | 4 |
25 files changed, 336 insertions, 265 deletions
@@ -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. @@ -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); @@ -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) { @@ -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 @@ -1436,11 +1436,6 @@ #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 @@ -1623,8 +1618,10 @@ #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 @@ -3629,11 +3626,6 @@ #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 @@ -3820,8 +3812,10 @@ #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 @@ -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" @@ -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 @@ -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 @@ -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 ); } } } @@ -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 */ @@ -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 */ @@ -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 @@ -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; @@ -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 */ @@ -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; @@ -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 @@ -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 @@ -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) @@ -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 @@ -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: { @@ -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); @@ -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; @@ -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; } } @@ -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); diff --git a/warnings.h b/warnings.h index 423a21a4c2..9c84c25a72 100644 --- a/warnings.h +++ b/warnings.h @@ -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)) |