#endif
#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
-/* According to some strict interpretations of ANSI C89 one cannot
- * cast void pointers to code pointers or vice versa (as filter_add(),
- * filter_del(), and filter_read() will want to do). We should still
- * be able to use a union for sneaky "casting". */
-typedef union {
- XPVIO* iop;
- filter_t filter;
-} xpvio_filter_u;
-
/*
* Convenience functions to return different tokens and prime the
* lexer for the next token. They all take an argument.
if (PL_oldbufptr && *PL_oldbufptr)
sv_catpv(report, PL_tokenbuf);
}
- PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen(report));
+ PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen_const(report));
};
return (int)rv;
}
void
Perl_lex_start(pTHX_ SV *line)
{
- char *s;
+ const char *s;
STRLEN len;
SAVEI32(PL_lex_dojoin);
PL_linestr = line;
if (SvREADONLY(PL_linestr))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
- s = SvPV(PL_linestr, len);
+ s = SvPV_const(PL_linestr, len);
if (!len || s[len-1] != ';') {
if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
NV retval = 0.0;
NV nshift = 1.0;
STRLEN len;
- const char *start = SvPVx_const(sv,len);
+ const char *start = SvPV_const(sv,len);
const char *end = start + len;
const bool utf = SvUTF8(sv) ? TRUE : FALSE;
while (start < end) {
if (SvTYPE(sv) == SVt_PVIV) {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
- const char *p = SvPV(sv, len);
+ const char *p = SvPV_const(sv, len);
SV * const nsv = newSVpvn(p, len);
if (SvUTF8(sv))
SvUTF8_on(nsv);
src = (U8 *)d - 1;
dst = src+hicount;
d += hicount;
- while (src >= (U8 *)SvPVX(sv)) {
+ while (src >= (const U8 *)SvPVX_const(sv)) {
if (!NATIVE_IS_INVARIANT(*src)) {
U8 ch = NATIVE_TO_ASCII(*src);
*dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
char* e = strchr(s, '}');
SV *res;
STRLEN len;
- char *str;
+ const char *str;
if (!e) {
yyerror("Missing right brace on \\N{}");
res, Nullsv, "\\N{...}" );
if (has_utf8)
sv_utf8_upgrade(res);
- str = SvPV(res,len);
+ str = SvPV_const(res,len);
#ifdef EBCDIC_NEVER_MIND
/* charnames uses pack U and that has been
* recently changed to do the below uni->native
* gets revoked, but the semantics is still
* desireable for charnames. --jhi */
{
- UV uv = utf8_to_uvchr((U8*)str, 0);
+ UV uv = utf8_to_uvchr((const U8*)str, 0);
if (uv < 0x100) {
U8 tmpbuf[UTF8_MAXBYTES+1], *d;
d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
- str = SvPV(res, len);
+ str = SvPV_const(res, len);
}
}
#endif
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
- xpvio_filter_u u;
-
if (!funcp)
return Nullsv;
if (!datasv)
datasv = NEWSV(255,0);
SvUPGRADE(datasv, SVt_PVIO);
- u.filter = funcp;
- IoANY(datasv) = u.iop; /* stash funcp into spare field */
+ IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
- (void*)u.iop, SvPV_nolen(datasv)));
+ IoANY(datasv), SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
Perl_filter_del(pTHX_ filter_t funcp)
{
SV *datasv;
- xpvio_filter_u u;
#ifdef DEBUGGING
- u.filter = funcp;
- DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)u.iop));
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp)));
#endif
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
- u.iop = IoANY(datasv);
- if (u.filter == funcp) {
+ if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) {
IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
IoANY(datasv) = (void *)NULL;
sv_free(av_pop(PL_rsfp_filters));
{
filter_t funcp;
SV *datasv = NULL;
- xpvio_filter_u u;
if (!PL_rsfp_filters)
return -1;
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
- u.iop = IoANY(datasv);
- funcp = u.filter;
+ funcp = DPTR2FPTR(filter_t, IoANY(datasv));
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
- idx, (void*)u.iop, SvPV_nolen(datasv)));
+ idx, datasv, SvPV_nolen_const(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) {
SV *sv;
if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
- pkgname = SvPV_nolen(sv);
+ pkgname = SvPV_nolen_const(sv);
}
}
else {
STRLEN blen;
STRLEN llen;
- const char *bstart = SvPV(CopFILESV(PL_curcop),blen);
- const char *lstart = SvPV(x,llen);
+ const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen);
+ const char *lstart = SvPV_const(x,llen);
if (llen < blen) {
bstart += blen - llen;
if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
if (!s)
missingterm((char*)0);
yylval.ival = OP_CONST;
+ /* FIXME. I think that this can be const if char *d is replaced by
+ more localised variables. */
for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
yylval.ival = OP_STRINGIFY;
/* Is there a prototype? */
if (SvPOK(cv)) {
STRLEN len;
- char *proto = SvPV((SV*)cv, len);
+ const char *proto = SvPV_const((SV*)cv, len);
if (!len)
TERM(FUNC0SUB);
if (*proto == '$' && proto[1] == '\0')
/* Check the eval first */
if (!PL_in_eval && SvTRUE(ERRSV)) {
- STRLEN n_a;
sv_catpv(ERRSV, "Propagated");
- yyerror(SvPV(ERRSV, n_a)); /* Duplicates the message inside eval */
+ yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */
(void)POPs;
res = SvREFCNT_inc(sv);
}
{
register char *s = start; /* current position in buffer */
register char *d;
- register char *e;
+ const char *e;
char *end;
I32 len;