if (DEBUG_T_TEST) {
const char *name = Nullch;
enum token_type type = TOKENTYPE_NONE;
- struct debug_tokens *p;
+ const struct debug_tokens *p;
SV* report = newSVpvn("<== ", 4);
- for (p = (struct debug_tokens *)debug_tokens; p->token; p++) {
+ for (p = debug_tokens; p->token; p++) {
if (p->token == (int)rv) {
name = p->name;
type = p->type;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\t(Missing semicolon on previous line?)\n");
else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) {
- char *t;
+ const char *t;
for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) ;
if (t < PL_bufptr && isSPACE(*t))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
static void
strip_return(SV *sv)
{
- register char *s = SvPVX(sv);
- register char *e = s + SvCUR(sv);
+ register const char *s = SvPVX(sv);
+ register const char *e = s + SvCUR(sv);
/* outer loop optimized to do nothing if there are no CR-LFs */
while (s < e) {
if (*s++ == '\r' && *s == '\n') {
STATIC I32
S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
- I32 count = FILTER_READ(idx+1, sv, maxlen);
+ const I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count > 0 && !maxlen)
strip_return(sv);
return count;
NV retval = 0.0;
NV nshift = 1.0;
STRLEN len;
- char *start = SvPVx(sv,len);
+ const char *start = SvPVx(sv,len);
+ const char *end = start + len;
bool utf = SvUTF8(sv) ? TRUE : FALSE;
- char *end = start + len;
while (start < end) {
STRLEN skip;
UV n;
STATIC I32
S_sublex_start(pTHX)
{
- register I32 op_type = yylval.ival;
+ const register I32 op_type = yylval.ival;
if (op_type == OP_NULL) {
yylval.opval = PL_lex_op;
if (SvTYPE(sv) == SVt_PVIV) {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
- char *p;
- SV *nsv;
-
- p = SvPV(sv, len);
- nsv = newSVpvn(p, len);
+ const char *p = SvPV(sv, len);
+ SV * const nsv = newSVpvn(p, len);
if (SvUTF8(sv))
SvUTF8_on(nsv);
SvREFCNT_dec(sv);
int weight = 2; /* let's weigh the evidence */
char seen[256];
unsigned char un_char = 255, last_un_char;
- char *send = strchr(s,']');
+ const char *send = strchr(s,']');
char tmpbuf[sizeof PL_tokenbuf * 4];
if (!send) /* has to be an expression */
if (GvIO(gv))
return 0;
if ((cv = GvCVu(gv))) {
- char *proto = SvPVX(cv);
+ const char *proto = SvPVX(cv);
if (proto) {
if (*proto == ';')
proto++;
if (maxlen) {
/* Want a block */
int len ;
- int old_len = SvCUR(buf_sv) ;
+ const int old_len = SvCUR(buf_sv);
/* ensure buf_sv is large enough */
SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ;
#endif
/* handle \E or end of string */
if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
- char oldmod;
-
/* if at a \E */
if (PL_lex_casemods) {
- oldmod = PL_lex_casestack[--PL_lex_casemods];
+ const char oldmod = PL_lex_casestack[--PL_lex_casemods];
PL_lex_casestack[PL_lex_casemods] = '\0';
if (PL_bufptr != PL_bufend
}
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
- sv_setpv(PL_linestr,"");
+ sv_setpvn(PL_linestr,"",0);
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
/* If it looks like the start of a BOM or raw UTF-16,
if (PL_doextract) {
/* Incest with pod. */
if (*s == '=' && strnEQ(s, "=cut", 4)) {
- sv_setpv(PL_linestr, "");
+ sv_setpvn(PL_linestr, "", 0);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
else {
STRLEN blen;
STRLEN llen;
- char *bstart = SvPV(CopFILESV(PL_curcop),blen);
- char *lstart = SvPV(x,llen);
+ const char *bstart = SvPV(CopFILESV(PL_curcop),blen);
+ const char *lstart = SvPV(x,llen);
if (llen < blen) {
bstart += blen - llen;
if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
* contains the start of the Perl program.
*/
if (d && *s != '#') {
- char *c = ipath;
+ const char *c = ipath;
while (*c && !strchr("; \t\r\n\f\v#", *c))
c++;
if (c < d)
}
#endif
if (d) {
- U32 oldpdb = PL_perldb;
- bool oldn = PL_minus_n;
- bool oldp = PL_minus_p;
+ const U32 oldpdb = PL_perldb;
+ const bool oldn = PL_minus_n;
+ const bool oldp = PL_minus_p;
while (*d && !isSPACE(*d)) d++;
while (SPACE_OR_TAB(*d)) d++;
if (*d++ == '-') {
- bool switches_done = PL_doswitches;
+ const bool switches_done = PL_doswitches;
do {
if (*d == 'M' || *d == 'm' || *d == 'C') {
- char *m = d;
+ const char *m = d;
while (*d && !isSPACE(*d)) d++;
Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
(int)(d - m), m);
/* if we have already added "LINE: while (<>) {",
we must not do it again */
{
- sv_setpv(PL_linestr, "");
+ sv_setpvn(PL_linestr, "", 0);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
}
tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */
if (*s != ';' && *s != '}' && *s != tmp && (tmp != '=' || *s != ')')) {
- char q = ((*s == '\'') ? '"' : '\'');
+ const char q = ((*s == '\'') ? '"' : '\'');
/* If here for an expression, and parsed no attrs, back off. */
if (tmp == '=' && !attrs) {
s = PL_bufptr;
while (d < PL_bufend && SPACE_OR_TAB(*d))
d++;
if (*d == '}') {
- char minus = (PL_tokenbuf[0] == '-');
+ const char minus = (PL_tokenbuf[0] == '-');
s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
if (minus)
force_next('-');
PL_expect = XSTATE;
break;
default: {
- char *t;
+ const char *t;
if (PL_oldoldbufptr == PL_last_lop)
PL_lex_brackstack[PL_lex_brackets++] = XTERM;
else
&& !isALNUM(*t))))
{
/* skip q//-like construct */
- char *tmps;
+ const char *tmps;
char open, close, term;
I32 brackets = 1;
goto retry;
}
if (PL_lex_brackets < PL_lex_formbrack) {
- char *t;
+ const char *t;
#ifdef PERL_STRICT_CR
for (t = s; SPACE_OR_TAB(*t); t++) ;
#else
* warn on m:!=~\s+([/?]|[msy]\W|tr\W): */
if (*s == '~' && ckWARN(WARN_SYNTAX)) {
- char *t = s+1;
+ const char *t = s+1;
while (t < PL_bufend && isSPACE(*t))
++t;
(t = strchr(s, '}')) && (t = strchr(t, '=')))
{
char tmpbuf[sizeof PL_tokenbuf];
- STRLEN len;
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST_lazy_if(t,UTF)) {
+ STRLEN len;
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
for (; isSPACE(*t); t++) ;
if (*t == ';' && get_cv(tmpbuf, FALSE))
PL_expect = XOPERATOR;
if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
- bool islop = (PL_last_lop == PL_oldoldbufptr);
+ const bool islop = (PL_last_lop == PL_oldoldbufptr);
if (!islop || PL_last_lop_op == OP_GREPSTART)
PL_expect = XOPERATOR;
else if (strchr("$@\"'`q", *s))
/* Warn about @ where they meant $. */
if (ckWARN(WARN_SYNTAX)) {
if (*s == '[' || *s == '{') {
- char *t = s + 1;
+ const char *t = s + 1;
while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
t++;
if (*t == '}' || *t == ']') {
case 'v':
if (isDIGIT(s[1]) && PL_expect != XOPERATOR) {
- char *start = s;
- start++;
- start++;
+ char *start = s + 2;
while (isDIGIT(*start) || *start == '_')
start++;
if (*start == '.' && isDIGIT(start[1])) {
else if (!isALPHA(*start) && (PL_expect == XTERM
|| PL_expect == XREF || PL_expect == XSTATE
|| PL_expect == XTERMORDORDOR)) {
- char c = *start;
+ const char c = *start;
GV *gv;
*start = '\0';
gv = gv_fetchpv(s, FALSE, SVt_PVCV);
just_a_word: {
SV *sv;
int pkgname = 0;
- char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
+ const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
/* Get the rest if it looks like a package qualifier */
IoIFP(GvIOp(gv)) = PL_rsfp;
#if defined(HAS_FCNTL) && defined(F_SETFD)
{
- int fd = PerlIO_fileno(PL_rsfp);
+ const int fd = PerlIO_fileno(PL_rsfp);
fcntl(fd,F_SETFD,fd >= 3);
}
#endif
case KEY_open:
s = skipspace(s);
if (isIDFIRST_lazy_if(s,UTF)) {
- char *t;
+ const char *t;
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
for (t=d; *t && isSPACE(*t); t++) ;
if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
SV *sv;
for (; isSPACE(*d) && len; --len, ++d) ;
if (len) {
- char *b = d;
+ const char *b = d;
if (!warned && ckWARN(WARN_QW)) {
for (; !isSPACE(*d) && len; --len, ++d) {
if (*d == ',') {
SSize_t tboffset = 0;
expectation attrful;
bool have_name, have_proto, bad_proto;
- int key = tmp;
+ const int key = tmp;
s = skipspace(s);
Perl_croak(aTHX_ "Missing name in \"my sub\"");
PL_expect = XTERMBLOCK;
attrful = XATTRTERM;
- sv_setpv(PL_subname,"?");
+ sv_setpvn(PL_subname,"?",1);
have_name = FALSE;
}
}
STATIC void
-S_checkcomma(pTHX_ register char *s, char *name, const char *what)
+S_checkcomma(pTHX_ register char *s, const char *name, const char *what)
{
- char *w;
+ const char *w;
if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
if (ckWARN(WARN_SYNTAX)) {
s++;
if (*s == ',') {
int kw;
- *s = '\0';
+ *s = '\0'; /* XXX If we didn't do this, we could const a lot of toke.c */
kw = keyword(w, s - w) || get_cv(w, FALSE) != 0;
*s = ',';
if (kw)
}
STATIC char *
-S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
+S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
register char *d;
register char *e;
if (bracket) {
if (isSPACE(s[-1])) {
while (s < send) {
- char ch = *s++;
+ const char ch = *s++;
if (!SPACE_OR_TAB(ch)) {
*d = ch;
break;
S_scan_pat(pTHX_ char *start, I32 type)
{
PMOP *pm;
- char *s;
+ char *s = scan_str(start,FALSE,FALSE);
- s = scan_str(start,FALSE,FALSE);
if (!s)
Perl_croak(aTHX_ "Search pattern not terminated");
register char *d;
register char *e;
char *peek;
- int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
+ const int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
s += 2;
d = PL_tokenbuf;
else {
/* handle quoted delimiters */
if (SvCUR(sv) > 1 && *(svlast-1) == '\\') {
- char *t;
+ const char *t;
for (t = svlast-2; t >= SvPVX(sv) && *t == '\\';)
t--;
if ((svlast-1 - t) % 2) {
cont = FALSE;
}
else {
- char *t, *w;
+ const char *t;
+ char *w;
if (!last)
last = SvPVX(sv);
- for (w = t = last; t < svlast; w++, t++) {
+ for (t = w = last; t < svlast; w++, t++) {
/* At here, all closes are "was quoted" one,
so we don't check PL_multi_close. */
if (*t == '\\') {
STATIC char*
S_swallow_bom(pTHX_ U8 *s)
{
- STRLEN slen;
- slen = SvCUR(PL_linestr);
+ const STRLEN slen = SvCUR(PL_linestr);
switch (s[0]) {
case 0xFF:
if (s[1] == 0xFE) {
static I32
utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
- STRLEN old = SvCUR(sv);
- I32 count = FILTER_READ(idx+1, sv, maxlen);
+ const STRLEN old = SvCUR(sv);
+ const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16_textfilter(%p): %d %d (%d)\n",
utf16_textfilter, idx, maxlen, (int) count));
static I32
utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
- STRLEN old = SvCUR(sv);
- I32 count = FILTER_READ(idx+1, sv, maxlen);
+ const STRLEN old = SvCUR(sv);
+ const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16rev_textfilter(%p): %d %d (%d)\n",
utf16rev_textfilter, idx, maxlen, (int) count));