*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.
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);
"%*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) {
# 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)
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
#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
* 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);
}
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;
GV** gvp;
CV* cv;
const char *hvname;
+ HV* lastchance = NULL;
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
/* 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,
SvOK_off(sv);
return;
}
- sv_setpv(sv, prefix ? prefix : "");
+ sv_setpv(sv, prefix ? prefix : (const char *)"");
name = HvNAME_get(hv);
if (name) {
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"
LOCK_SV_MUTEX;
if (!*root)
S_more_he(aTHX);
- he = *root;
+ he = (HE*) *root;
assert(he);
*root = HeNEXT(he);
UNLOCK_SV_MUTEX;
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
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
{
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
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
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
{
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);
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;
#endif
EXTEND(SP, 2);
PUSHs((SV*)rv);
- PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+ PUSHs(newSVpv((char *)sip, sizeof(*sip)));
}
va_end(args);
/* 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 );
}
}
}
|| 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);
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);
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');
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) {
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
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)
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 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);
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);
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) &&
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);
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 */
#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
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 */
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
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,
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);
}
{
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;
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))
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;
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);
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;
}
}
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) {
RETPUSHNO;
key = SvPV(*svp, key_len);
- if(!hv_exists((HV *) this, key, key_len))
+ if(!hv_exists((HV *) This, key, key_len))
RETPUSHNO;
}
RETPUSHYES;
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;
}
RETPUSHNO;
}
else {
- if (hv_exists_ent((HV *) this, other, 0))
+ if (hv_exists_ent((HV *) This, Other, 0))
RETPUSHYES;
else
RETPUSHNO;
}
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;
(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) {
}
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;
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)
}
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();
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);
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
- c = call_sv(this, G_SCALAR);
+ c = call_sv(This, G_SCALAR);
SPAGAIN;
if (c == 0)
PUSHs(&PL_sv_undef);
/* 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);
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;
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;
}
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;
/* 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 */
(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; \
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 */
* 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)
* 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;
register IO *io;
GV *fgv;
CV *cv;
+ SV * tmpsv = NULL;
if (MAXARG == 0)
gv = PL_defoutgv;
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)
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
{
dVAR;
dSP;
- GV *gv;
+ GV *gv = NULL;
IO *io;
I32 gimme;
I32 max = 13;
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
__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)
__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
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;
}
}
#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 */
I32 min;
I32 max = REG_INFTY;
char *parse_start;
+ const char *maxpos = NULL;
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_PARSE("piec");
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 == ',') {
}
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)
subpattern */
U32 state_num;
+ I32 parenfloor = 0;
+
#ifdef DEBUGGING
GET_RE_DEBUG_FLAGS_DECL;
PL_regindent++;
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
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:
{
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);
}
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)) {
|| 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));
}
} 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);
#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 */
/* 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);
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;
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",
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");
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;
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(':');
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);
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);
}
}
#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
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);
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);
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
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);
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), '#'))
#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 {
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;
if (flags & UTF8_CHECK_ONLY) {
if (retlen)
- *retlen = -1;
+ *retlen = ((STRLEN) -1);
return 0;
}
{
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.
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)) {
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;
}
}
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);
}
}
if (!newaddr) {
return write_no_mem();
}
- return memcpy(newaddr,pv,pvlen);
+ return (char*)memcpy(newaddr, pv, pvlen);
}
/*
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;
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",
}
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);
#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))