#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.
const char *name = Nullch;
enum token_type type = TOKENTYPE_NONE;
const struct debug_tokens *p;
- SV* report = newSVpvn("<== ", 4);
+ SV* const report = newSVpvn("<== ", 4);
for (p = debug_tokens; p->token; p++) {
if (p->token == (int)rv) {
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;
}
STATIC void
S_no_op(pTHX_ const char *what, char *s)
{
- char *oldbp = PL_bufptr;
- bool is_first = (PL_oldbufptr == PL_linestart);
+ char * const oldbp = PL_bufptr;
+ const bool is_first = (PL_oldbufptr == PL_linestart);
if (!s)
s = oldbp;
char tmpbuf[3];
char q;
if (s) {
- char *nl = strrchr(s,'\n');
+ char * const nl = strrchr(s,'\n');
if (nl)
*nl = '\0';
}
strip_return(SV *sv)
{
register const char *s = SvPVX_const(sv);
- register const char *e = s + SvCUR(sv);
+ register const char * const e = s + SvCUR(sv);
/* outer loop optimized to do nothing if there are no CR-LFs */
while (s < e) {
if (*s++ == '\r' && *s == '\n') {
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));
* so store the line into the debugger's array of lines
*/
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(85,0);
+ SV * const sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
if (ckWARN_d(WARN_AMBIGUOUS)){
- char ch = *s;
+ const char ch = *s;
*s = '\0';
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Warning: Use of \"%s\" without parentheses is ambiguous",
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
- SV *sv = newSVpvn(start,len);
+ SV * const sv = newSVpvn(start,len);
if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
SvUTF8_on(sv);
return sv;
NV retval = 0.0;
NV nshift = 1.0;
STRLEN len;
- const char *start = SvPVx_const(sv,len);
- const char *end = start + len;
+ const char *start = SvPV_const(sv,len);
+ const char * const end = start + len;
const bool utf = SvUTF8(sv) ? TRUE : FALSE;
while (start < end) {
STRLEN skip;
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);
{
dVAR;
if (!PL_lex_starts++) {
- SV *sv = newSVpvn("",0);
+ SV * const sv = newSVpvn("",0);
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
I32 max; /* last character in range */
if (has_utf8) {
- char *c = (char*)utf8_hop((U8*)d, -1);
+ char * const c = (char*)utf8_hop((U8*)d, -1);
char *e = d++;
while (e-- > c)
*(e + 1) = *e;
case 'x':
++s;
if (*s == '{') {
- char* e = strchr(s, '}');
+ char* const e = strchr(s, '}');
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
PERL_SCAN_DISALLOW_PREFIX;
STRLEN len;
}
}
if (hicount) {
- STRLEN offset = d - SvPVX_const(sv);
+ const STRLEN offset = d - SvPVX_const(sv);
U8 *src, *dst;
d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset;
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);
+ const U8 ch = NATIVE_TO_ASCII(*src);
*dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
*dst-- = (U8)UTF8_EIGHT_BIT_HI(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
if (!has_utf8 && SvUTF8(res)) {
- const char *ostart = SvPVX_const(sv);
+ const char * const ostart = SvPVX_const(sv);
SvCUR_set(sv, d - ostart);
SvPOK_on(sv);
*d = '\0';
has_utf8 = TRUE;
}
if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
- const char *odest = SvPVX_const(sv);
+ const char * const odest = SvPVX_const(sv);
SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
d = SvPVX(sv) + (d - odest);
and then encode the next character */
if ((has_utf8 || this_utf8) && !NATIVE_IS_INVARIANT((U8)(*s))) {
STRLEN len = 1;
- UV uv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
- STRLEN need = UNISKIP(NATIVE_TO_UNI(uv));
+ const UV uv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
+ const STRLEN need = UNISKIP(NATIVE_TO_UNI(uv));
s += len;
if (need > len) {
/* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */
- STRLEN off = d - SvPVX_const(sv);
+ const STRLEN off = d - SvPVX_const(sv);
d = SvGROW(sv, SvLEN(sv) + (need-len)) + off;
}
d = (char*)uvchr_to_utf8((U8*)d, uv);
int weight = 2; /* let's weigh the evidence */
char seen[256];
unsigned char un_char = 255, last_un_char;
- const char *send = strchr(s,']');
+ const char * const send = strchr(s,']');
char tmpbuf[sizeof PL_tokenbuf * 4];
if (!send) /* has to be an expression */
S_incl_perldb(pTHX)
{
if (PL_perldb) {
- const char *pdb = PerlEnv_getenv("PERL5DB");
+ const char * const pdb = PerlEnv_getenv("PERL5DB");
if (pdb)
return pdb;
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 */
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(85,0);
+ SV * const sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
} while (PL_doextract);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(85,0);
+ SV * const sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
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 * const lstart = SvPV_const(x,llen);
if (llen < blen) {
bstart += blen - llen;
if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
const bool switches_done = PL_doswitches;
do {
if (*d == 'M' || *d == 'm' || *d == 'C') {
- const char *m = d;
+ const char * const m = d;
while (*d && !isSPACE(*d)) d++;
Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
(int)(d - m), m);
s = skipspace(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
- char *t;
if (*s == '[') {
PL_tokenbuf[0] = '@';
if (ckWARN(WARN_SYNTAX)) {
+ char *t;
for(t = s + 1;
isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
t++) ;
}
}
else if (*s == '{') {
+ char *t;
PL_tokenbuf[0] = '%';
if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
(t = strchr(s, '}')) && (t = strchr(t, '=')))
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')
case KEY___DATA__:
case KEY___END__: {
GV *gv;
-
- /*SUPPRESS 560*/
if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
const char *pname = "main";
if (PL_tokenbuf[2] == 'D')
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
/* build ops for a bareword */
- HV *stash = PAD_COMPNAME_OURSTASH(tmp);
- HEK *stashname = HvNAME_HEK(stash);
- SV *sym = newSVhek(stashname);
+ HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
+ HEK * const stashname = HvNAME_HEK(stash);
+ SV * const sym = newSVhek(stashname);
sv_catpvn(sym, "::", 2);
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
SV *res;
SV **cvp;
SV *cv, *typesv;
- const char *why1, *why2, *why3;
+ const char *why1 = "", *why2 = "", *why3 = "";
if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
SV *msg;
PMOP *pm;
char *s = scan_str(start,FALSE,FALSE);
- if (!s)
- Perl_croak(aTHX_ "Search pattern not terminated");
+ if (!s) {
+ char *delimiter = skipspace(start);
+ Perl_croak(aTHX_ *delimiter == '?'
+ ? "Search pattern not terminated or ternary operator parsed as search pattern"
+ : "Search pattern not terminated" );
+ }
pm = (PMOP*)newPMOP(type, 0);
if (PL_multi_open == '?')
{
register char *s = start; /* current position in buffer */
register char *d;
- register char *e;
+ const char *e;
char *end;
I32 len;
while (!needargs) {
if (*s == '.') {
- /*SUPPRESS 530*/
#ifdef PERL_STRICT_CR
for (t = s+1;SPACE_OR_TAB(*t); t++) ;
#else
projects / p5sagit/p5-mst-13.2.git / blobdiff