/* toke.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define yychar (*PL_yycharp)
#define yylval (*PL_yylvalp)
-static const char ident_too_long[] =
- "Identifier too long";
-static const char c_without_g[] =
- "Use of /c modifier is meaningless without /g";
-static const char c_in_subst[] =
- "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] = "Identifier too long";
+static const char commaless_variable_list[] = "comma-less variable list";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
#endif
+#ifdef PERL_MAD
+/* XXX these probably need to be made into PL vars */
+static I32 realtokenstart;
+static I32 faketokens = 0;
+static MADPROP *thismad;
+static SV *thistoken;
+static SV *thisopen;
+static SV *thisstuff;
+static SV *thisclose;
+static SV *thiswhite;
+static SV *nextwhite;
+static SV *skipwhite;
+static SV *endwhite;
+static I32 curforce = -1;
+
+# define CURMAD(slot,sv) if (PL_madskills) { curmad(slot,sv); sv = 0; }
+
+# define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke]
+#else
+# define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke]
+#endif
+
#define XFAKEBRACK 128
#define XENUMMASK 127
/* #define LEX_NOTPARSING 11 is done in perl.h. */
-#define LEX_NORMAL 10
-#define LEX_INTERPNORMAL 9
-#define LEX_INTERPCASEMOD 8
-#define LEX_INTERPPUSH 7
-#define LEX_INTERPSTART 6
-#define LEX_INTERPEND 5
-#define LEX_INTERPENDMAYBE 4
-#define LEX_INTERPCONCAT 3
-#define LEX_INTERPCONST 2
-#define LEX_FORMLINE 1
-#define LEX_KNOWNEXT 0
+#define LEX_NORMAL 10 /* normal code (ie not within "...") */
+#define LEX_INTERPNORMAL 9 /* code within a string, eg "$foo[$x+1]" */
+#define LEX_INTERPCASEMOD 8 /* expecting a \U, \Q or \E etc */
+#define LEX_INTERPPUSH 7 /* starting a new sublex parse level */
+#define LEX_INTERPSTART 6 /* expecting the start of a $var */
+
+ /* at end of code, eg "$x" followed by: */
+#define LEX_INTERPEND 5 /* ... eg not one of [, { or -> */
+#define LEX_INTERPENDMAYBE 4 /* ... eg one of [, { or -> */
+
+#define LEX_INTERPCONCAT 3 /* expecting anything, eg at start of
+ string or after \E, $foo, etc */
+#define LEX_INTERPCONST 2 /* NOT USED */
+#define LEX_FORMLINE 1 /* expecting a format line */
+#define LEX_KNOWNEXT 0 /* next token known; just return it */
+
#ifdef DEBUGGING
static const char* const lex_state_names[] = {
#endif
#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
+#if 0 && defined(PERL_MAD)
+# define SKIPSPACE0(s) skipspace0(s)
+# define SKIPSPACE1(s) skipspace1(s)
+# define SKIPSPACE2(s,tsv) skipspace2(s,&tsv)
+# define PEEKSPACE(s) skipspace2(s,0)
+#else
+# define SKIPSPACE0(s) skipspace(s)
+# define SKIPSPACE1(s) skipspace(s)
+# define SKIPSPACE2(s,tsv) skipspace(s)
+# define PEEKSPACE(s) skipspace(s)
+#endif
+
/*
* Convenience functions to return different tokens and prime the
* lexer for the next token. They all take an argument.
*/
#ifdef DEBUGGING /* Serve -DT. */
-# define REPORT(retval) tokereport(s,(int)retval)
+# define REPORT(retval) tokereport((I32)retval)
#else
# define REPORT(retval) (retval)
#endif
PL_last_lop_op = f; \
if (*s == '(') \
return REPORT( (int)FUNC1 ); \
- s = skipspace(s); \
+ s = PEEKSPACE(s); \
return REPORT( *s=='(' ? (int)FUNC1 : (int)UNIOP ); \
}
#define UNI(f) UNI2(f,XTERM)
PL_last_uni = PL_oldbufptr; \
if (*s == '(') \
return REPORT( (int)FUNC1 ); \
- s = skipspace(s); \
+ s = PEEKSPACE(s); \
return REPORT( (*s == '(') ? (int)FUNC1 : (int)UNIOP ); \
}
TOKENTYPE_GVVAL
};
-static struct debug_tokens { const int token, type; const char *name; }
- const debug_tokens[] =
+static struct debug_tokens {
+ const int token;
+ enum token_type type;
+ const char *name;
+} const debug_tokens[] =
{
{ ADDOP, TOKENTYPE_OPNUM, "ADDOP" },
{ ANDAND, TOKENTYPE_NONE, "ANDAND" },
{ BITOROP, TOKENTYPE_OPNUM, "BITOROP" },
{ COLONATTR, TOKENTYPE_NONE, "COLONATTR" },
{ CONTINUE, TOKENTYPE_NONE, "CONTINUE" },
+ { DEFAULT, TOKENTYPE_NONE, "DEFAULT" },
{ DO, TOKENTYPE_NONE, "DO" },
{ DOLSHARP, TOKENTYPE_NONE, "DOLSHARP" },
{ DORDOR, TOKENTYPE_NONE, "DORDOR" },
{ FUNC0SUB, TOKENTYPE_OPVAL, "FUNC0SUB" },
{ FUNC1, TOKENTYPE_OPNUM, "FUNC1" },
{ FUNCMETH, TOKENTYPE_OPVAL, "FUNCMETH" },
+ { GIVEN, TOKENTYPE_IVAL, "GIVEN" },
{ HASHBRACK, TOKENTYPE_NONE, "HASHBRACK" },
{ IF, TOKENTYPE_IVAL, "IF" },
{ LABEL, TOKENTYPE_PVAL, "LABEL" },
{ UNLESS, TOKENTYPE_IVAL, "UNLESS" },
{ UNTIL, TOKENTYPE_IVAL, "UNTIL" },
{ USE, TOKENTYPE_IVAL, "USE" },
+ { WHEN, TOKENTYPE_IVAL, "WHEN" },
{ WHILE, TOKENTYPE_IVAL, "WHILE" },
{ WORD, TOKENTYPE_OPVAL, "WORD" },
{ 0, TOKENTYPE_NONE, 0 }
/* dump the returned token in rv, plus any optional arg in yylval */
STATIC int
-S_tokereport(pTHX_ const char* s, I32 rv)
+S_tokereport(pTHX_ I32 rv)
{
+ dVAR;
if (DEBUG_T_TEST) {
- const char *name = Nullch;
+ const char *name = NULL;
enum token_type type = TOKENTYPE_NONE;
const struct debug_tokens *p;
- SV* const report = newSVpvn("<== ", 4);
+ SV* const report = newSVpvs("<== ");
for (p = debug_tokens; p->token; p++) {
if (p->token == (int)rv) {
else if ((char)rv > ' ' && (char)rv < '~')
Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
else if (!rv)
- Perl_sv_catpv(aTHX_ report, "EOF");
+ sv_catpvs(report, "EOF");
else
Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
switch (type) {
Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
break;
case TOKENTYPE_OPVAL:
- if (yylval.opval)
+ if (yylval.opval) {
Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
PL_op_name[yylval.opval->op_type]);
+ if (yylval.opval->op_type == OP_CONST) {
+ Perl_sv_catpvf(aTHX_ report, " %s",
+ SvPEEK(cSVOPx_sv(yylval.opval)));
+ }
+
+ }
else
- Perl_sv_catpv(aTHX_ report, "(opval=null)");
+ sv_catpvs(report, "(opval=null)");
break;
}
- Perl_sv_catpvf(aTHX_ report, " at line %"IVdf" [", (IV)CopLINE(PL_curcop));
- if (s - PL_bufptr > 0)
- sv_catpvn(report, PL_bufptr, s - PL_bufptr);
- else {
- if (PL_oldbufptr && *PL_oldbufptr)
- sv_catpv(report, PL_tokenbuf);
- }
- PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen_const(report));
+ PerlIO_printf(Perl_debug_log, "### %s\n\n", SvPV_nolen_const(report));
};
return (int)rv;
}
+
+/* print the buffer with suitable escapes */
+
+STATIC void
+S_printbuf(pTHX_ const char* fmt, const char* s)
+{
+ SV* const tmp = newSVpvs("");
+ PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
+ SvREFCNT_dec(tmp);
+}
+
#endif
/*
STATIC int
S_ao(pTHX_ int toketype)
{
+ dVAR;
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
STATIC void
S_no_op(pTHX_ const char *what, char *s)
{
+ dVAR;
char * const oldbp = PL_bufptr;
const bool is_first = (PL_oldbufptr == PL_linestart);
if (t < PL_bufptr && isSPACE(*t))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\t(Do you need to predeclare %.*s?)\n",
- t - PL_oldoldbufptr, PL_oldoldbufptr);
+ (int)(t - PL_oldoldbufptr), PL_oldoldbufptr);
}
else {
assert(s >= oldbp);
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
+ "\t(Missing operator before %.*s?)\n", (int)(s - oldbp), oldbp);
}
}
PL_bufptr = oldbp;
STATIC void
S_missingterm(pTHX_ char *s)
{
+ dVAR;
char tmpbuf[3];
char q;
if (s) {
#endif
) {
*tmpbuf = '^';
- tmpbuf[1] = toCTRL(PL_multi_close);
+ tmpbuf[1] = (char)toCTRL(PL_multi_close);
tmpbuf[2] = '\0';
s = tmpbuf;
}
Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
}
+#define FEATURE_IS_ENABLED(name) \
+ ((0 != (PL_hints & HINT_LOCALIZE_HH)) \
+ && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
+/*
+ * S_feature_is_enabled
+ * Check whether the named feature is enabled.
+ */
+STATIC bool
+S_feature_is_enabled(pTHX_ char *name, STRLEN namelen)
+{
+ dVAR;
+ HV * const hinthv = GvHV(PL_hintgv);
+ char he_name[32] = "feature_";
+ (void) strncpy(&he_name[8], name, 24);
+
+ return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
+}
+
/*
* Perl_deprecate
*/
}
/*
- * depcom
- * Deprecate a comma-less variable list.
- */
-
-STATIC void
-S_depcom(pTHX)
-{
- deprecate_old("comma-less variable list");
-}
-
-/*
* experimental text filters for win32 carriage-returns, utf16-to-utf8 and
* utf16-to-utf8-reversed.
*/
void
Perl_lex_start(pTHX_ SV *line)
{
+ dVAR;
const char *s;
STRLEN len;
*PL_lex_casestack = '\0';
PL_lex_dojoin = 0;
PL_lex_starts = 0;
- PL_lex_stuff = Nullsv;
- PL_lex_repl = Nullsv;
+ PL_lex_stuff = NULL;
+ PL_lex_repl = NULL;
PL_lex_inpat = 0;
PL_nexttoke = 0;
PL_lex_inwhat = 0;
if (!len || s[len-1] != ';') {
if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
- sv_catpvn(PL_linestr, "\n;", 2);
+ sv_catpvs(PL_linestr, "\n;");
}
SvTEMP_off(PL_linestr);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend = PL_bufptr + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
PL_rsfp = 0;
}
void
Perl_lex_end(pTHX)
{
+ dVAR;
PL_doextract = FALSE;
}
STATIC void
S_incline(pTHX_ char *s)
{
+ dVAR;
char *t;
char *n;
char *e;
ch = *t;
*t = '\0';
if (t - s > 0) {
+#ifndef USE_ITHREADS
+ const char * const cf = CopFILE(PL_curcop);
+ STRLEN tmplen = cf ? strlen(cf) : 0;
+ if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
+ /* must copy *{"::_<(eval N)[oldfilename:L]"}
+ * to *{"::_<newfilename"} */
+ char smallbuf[256], smallbuf2[256];
+ char *tmpbuf, *tmpbuf2;
+ GV **gvp, *gv2;
+ STRLEN tmplen2 = strlen(s);
+ if (tmplen + 3 < sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else
+ Newx(tmpbuf, tmplen + 3, char);
+ if (tmplen2 + 3 < sizeof smallbuf2)
+ tmpbuf2 = smallbuf2;
+ else
+ Newx(tmpbuf2, tmplen2 + 3, char);
+ tmpbuf[0] = tmpbuf2[0] = '_';
+ tmpbuf[1] = tmpbuf2[1] = '<';
+ memcpy(tmpbuf + 2, cf, ++tmplen);
+ memcpy(tmpbuf2 + 2, s, ++tmplen2);
+ ++tmplen; ++tmplen2;
+ gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
+ if (gvp) {
+ gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
+ if (!isGV(gv2))
+ gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
+ /* adjust ${"::_<newfilename"} to store the new file name */
+ GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+ GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+ GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+ }
+ if (tmpbuf != smallbuf) Safefree(tmpbuf);
+ if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
+ }
+#endif
CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, s);
}
CopLINE_set(PL_curcop, atoi(n)-1);
}
+#ifdef PERL_MAD
+/* skip space before thistoken */
+
+STATIC char *
+S_skipspace0(pTHX_ register char *s)
+{
+ s = skipspace(s);
+ if (!PL_madskills)
+ return s;
+ if (skipwhite) {
+ if (!thiswhite)
+ thiswhite = newSVpvn("",0);
+ sv_catsv(thiswhite, skipwhite);
+ sv_free(skipwhite);
+ skipwhite = 0;
+ }
+ realtokenstart = s - SvPVX(PL_linestr);
+ return s;
+}
+
+/* skip space after thistoken */
+
+STATIC char *
+S_skipspace1(pTHX_ register char *s)
+{
+ char *start = s;
+ I32 startoff = start - SvPVX(PL_linestr);
+
+ s = skipspace(s);
+ if (!PL_madskills)
+ return s;
+ start = SvPVX(PL_linestr) + startoff;
+ if (!thistoken && realtokenstart >= 0) {
+ char *tstart = SvPVX(PL_linestr) + realtokenstart;
+ thistoken = newSVpvn(tstart, start - tstart);
+ }
+ realtokenstart = -1;
+ if (skipwhite) {
+ if (!nextwhite)
+ nextwhite = newSVpvn("",0);
+ sv_catsv(nextwhite, skipwhite);
+ sv_free(skipwhite);
+ skipwhite = 0;
+ }
+ return s;
+}
+
+STATIC char *
+S_skipspace2(pTHX_ register char *s, SV **svp)
+{
+ char *start = s;
+ I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
+ I32 startoff = start - SvPVX(PL_linestr);
+ s = skipspace(s);
+ PL_bufptr = SvPVX(PL_linestr) + bufptroff;
+ if (!PL_madskills || !svp)
+ return s;
+ start = SvPVX(PL_linestr) + startoff;
+ if (!thistoken && realtokenstart >= 0) {
+ char *tstart = SvPVX(PL_linestr) + realtokenstart;
+ thistoken = newSVpvn(tstart, start - tstart);
+ realtokenstart = -1;
+ }
+ if (skipwhite) {
+ if (!*svp)
+ *svp = newSVpvn("",0);
+ sv_setsv(*svp, skipwhite);
+ sv_free(skipwhite);
+ skipwhite = 0;
+ }
+
+ return s;
+}
+#endif
+
/*
* S_skipspace
* Called to gobble the appropriate amount and type of whitespace.
STATIC char *
S_skipspace(pTHX_ register char *s)
{
+ dVAR;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
/* try to recharge the buffer */
if ((s = filter_gets(PL_linestr, PL_rsfp,
- (prevlen = SvCUR(PL_linestr)))) == Nullch)
+ (prevlen = SvCUR(PL_linestr)))) == NULL)
{
/* end of file. Add on the -p or -n magic */
if (PL_minus_p) {
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
= SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
/* Close the filehandle. Could be from -P preprocessor,
* STDIN, or a regular file. If we were reading code from
PerlIO_clearerr(PL_rsfp);
else
(void)PerlIO_close(PL_rsfp);
- PL_rsfp = Nullfp;
+ PL_rsfp = NULL;
return s;
}
* so store the line into the debugger's array of lines
*/
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = NEWSV(85,0);
+ SV * const sv = newSV(0);
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
STATIC void
S_check_uni(pTHX)
{
+ dVAR;
char *s;
char *t;
for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) ;
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
+
+ /* XXX Things like this are just so nasty. We shouldn't be modifying
+ source code, even if we realquick set it back. */
if (ckWARN_d(WARN_AMBIGUOUS)){
const char ch = *s;
*s = '\0';
STATIC I32
S_lop(pTHX_ I32 f, int x, char *s)
{
+ dVAR;
yylval.ival = f;
CLINE;
PL_expect = x;
return REPORT(LSTOP);
if (*s == '(')
return REPORT(FUNC);
- s = skipspace(s);
+ s = PEEKSPACE(s);
if (*s == '(')
return REPORT(FUNC);
else
STATIC void
S_force_next(pTHX_ I32 type)
{
+ dVAR;
PL_nexttype[PL_nexttoke] = type;
PL_nexttoke++;
if (PL_lex_state != LEX_KNOWNEXT) {
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
+ dVAR;
SV * const sv = newSVpvn(start,len);
if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
SvUTF8_on(sv);
STATIC char *
S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
{
+ dVAR;
register char *s;
STRLEN len;
- start = skipspace(start);
+ start = SKIPSPACE1(start);
s = start;
if (isIDFIRST_lazy_if(s,UTF) ||
(allow_pack && *s == ':') ||
if (check_keyword && keyword(PL_tokenbuf, len))
return start;
if (token == METHOD) {
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (*s == '(')
PL_expect = XTERM;
else {
PL_expect = XOPERATOR;
}
}
- PL_nextval[PL_nexttoke].opval
+ NEXTVAL_NEXTTOKE.opval
= (OP*)newSVOP(OP_CONST,0,
S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
- PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
+ NEXTVAL_NEXTTOKE.opval->op_private |= OPpCONST_BARE;
force_next(token);
}
return s;
STATIC void
S_force_ident(pTHX_ register const char *s, int kind)
{
+ dVAR;
if (s && *s) {
- OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
- PL_nextval[PL_nexttoke].opval = o;
+ const STRLEN len = strlen(s);
+ OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len));
+ NEXTVAL_NEXTTOKE.opval = o;
force_next(WORD);
if (kind) {
o->op_private = OPpCONST_ENTERED;
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
- gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
- kind == '$' ? SVt_PV :
- kind == '@' ? SVt_PVAV :
- kind == '%' ? SVt_PVHV :
+ gv_fetchpvn_flags(s, len,
+ PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL)
+ : GV_ADD,
+ kind == '$' ? SVt_PV :
+ kind == '@' ? SVt_PVAV :
+ kind == '%' ? SVt_PVHV :
SVt_PVGV
- );
+ );
}
}
}
STATIC char *
S_force_version(pTHX_ char *s, int guessing)
{
- OP *version = Nullop;
+ dVAR;
+ OP *version = NULL;
char *d;
- s = skipspace(s);
+ s = SKIPSPACE1(s);
d = s;
if (*d == 'v')
}
/* NOTE: The parser sees the package name and the VERSION swapped */
- PL_nextval[PL_nexttoke].opval = version;
+ NEXTVAL_NEXTTOKE.opval = version;
force_next(WORD);
return s;
STATIC SV *
S_tokeq(pTHX_ SV *sv)
{
+ dVAR;
register char *s;
register char *send;
register char *d;
STATIC I32
S_sublex_start(pTHX)
{
- const register I32 op_type = yylval.ival;
+ dVAR;
+ register const I32 op_type = yylval.ival;
if (op_type == OP_NULL) {
yylval.opval = PL_lex_op;
- PL_lex_op = Nullop;
+ PL_lex_op = NULL;
return THING;
}
if (op_type == OP_CONST || op_type == OP_READLINE) {
if (SvTYPE(sv) == SVt_PVIV) {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
- const char *p = SvPV_const(sv, len);
+ const char * const p = SvPV_const(sv, len);
SV * const nsv = newSVpvn(p, len);
if (SvUTF8(sv))
SvUTF8_on(nsv);
sv = nsv;
}
yylval.opval = (OP*)newSVOP(op_type, 0, sv);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
/* Allow <FH> // "foo" */
if (op_type == OP_READLINE)
PL_expect = XTERMORDORDOR;
PL_expect = XTERM;
if (PL_lex_op) {
yylval.opval = PL_lex_op;
- PL_lex_op = Nullop;
+ PL_lex_op = NULL;
return PMFUNC;
}
else
SAVEGENERICPV(PL_lex_casestack);
PL_linestr = PL_lex_stuff;
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
= SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
PL_lex_inpat = PL_sublex_info.sub_op;
else
- PL_lex_inpat = Nullop;
+ PL_lex_inpat = NULL;
return '(';
}
{
dVAR;
if (!PL_lex_starts++) {
- SV * const sv = newSVpvn("",0);
+ SV * const sv = newSVpvs("");
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
PL_lex_inpat = 0;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
PL_lex_brackets = 0;
}
else {
PL_lex_state = LEX_INTERPCONCAT;
- PL_lex_repl = Nullsv;
+ PL_lex_repl = NULL;
}
return ',';
}
STATIC char *
S_scan_const(pTHX_ char *start)
{
+ dVAR;
register char *send = PL_bufend; /* end of the constant */
- SV *sv = NEWSV(93, send - start); /* sv for the constant */
+ SV *sv = newSV(send - start); /* sv for the constant */
register char *s = start; /* start of the constant */
register char *d = SvPVX(sv); /* destination for copies */
bool dorange = FALSE; /* are we in a translit range? */
goto NUM_ESCAPE_INSERT;
}
res = newSVpvn(s + 1, e - s - 1);
- res = new_constant( Nullch, 0, "charnames",
- res, Nullsv, "\\N{...}" );
+ res = new_constant( NULL, 0, "charnames",
+ res, NULL, "\\N{...}" );
if (has_utf8)
sv_utf8_upgrade(res);
str = SvPV_const(res,len);
and then encode the next character */
if ((has_utf8 || this_utf8) && !NATIVE_IS_INVARIANT((U8)(*s))) {
STRLEN len = 1;
- 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));
+ const UV nextuv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
+ const STRLEN need = UNISKIP(NATIVE_TO_UNI(nextuv));
s += len;
if (need > len) {
/* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */
const STRLEN off = d - SvPVX_const(sv);
d = SvGROW(sv, SvLEN(sv) + (need-len)) + off;
}
- d = (char*)uvchr_to_utf8((U8*)d, uv);
+ d = (char*)uvchr_to_utf8((U8*)d, nextuv);
has_utf8 = TRUE;
}
else {
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, Nullsv,
+ sv, NULL,
( PL_lex_inwhat == OP_TRANS
? "tr"
: ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
STATIC int
S_intuit_more(pTHX_ register char *s)
{
+ dVAR;
if (PL_lex_brackets)
return TRUE;
if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
case '$':
weight -= seen[un_char] * 10;
if (isALNUM_lazy_if(s+1,UTF)) {
+ int len;
scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
- if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
+ len = (int)strlen(tmpbuf);
+ if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PV))
weight -= 100;
else
weight -= 10;
*/
STATIC int
-S_intuit_method(pTHX_ char *start, GV *gv)
+S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
{
+ dVAR;
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
GV* indirgv;
if (gv) {
- CV *cv;
- if (GvIO(gv))
+ if (SvTYPE(gv) == SVt_PVGV && GvIO(gv))
return 0;
- if ((cv = GvCVu(gv))) {
- const char *proto = SvPVX_const(cv);
- if (proto) {
- if (*proto == ';')
- proto++;
- if (*proto == '*')
- return 0;
+ if (cv) {
+ if (SvPOK(cv)) {
+ const char *proto = SvPVX_const(cv);
+ if (proto) {
+ if (*proto == ';')
+ proto++;
+ if (*proto == '*')
+ return 0;
+ }
}
} else
gv = 0;
if (*start == '$') {
if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
return 0;
- s = skipspace(s);
+ s = PEEKSPACE(s);
PL_bufptr = start;
PL_expect = XREF;
return *s == '(' ? FUNCMETH : METHOD;
tmpbuf[len] = '\0';
goto bare_package;
}
- indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
+ indirgv = gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PVCV);
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
- s = skipspace(s);
+ s = PEEKSPACE(s);
if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
return 0; /* no assumptions -- "=>" quotes bearword */
bare_package:
- PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
+ NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0,
newSVpvn(tmpbuf,len));
- PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
+ NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE;
PL_expect = XTERM;
force_next(WORD);
PL_bufptr = s;
STATIC const char*
S_incl_perldb(pTHX)
{
+ dVAR;
if (PL_perldb) {
const char * const pdb = PerlEnv_getenv("PERL5DB");
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
+ dVAR;
if (!funcp)
- return Nullsv;
+ return NULL;
if (!PL_rsfp_filters)
PL_rsfp_filters = newAV();
if (!datasv)
- datasv = NEWSV(255,0);
+ datasv = newSV(0);
SvUPGRADE(datasv, SVt_PVIO);
IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
IoFLAGS(datasv) |= IOf_FAKE_DIRP;
void
Perl_filter_del(pTHX_ filter_t funcp)
{
+ dVAR;
SV *datasv;
#ifdef DEBUGGING
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
filter_t funcp;
SV *datasv = NULL;
STATIC char *
S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
{
+ dVAR;
#ifdef PERL_CR_FILTER
if (!PL_rsfp_filters) {
filter_add(S_cr_textfilter,NULL);
if (FILTER_READ(0, sv, 0) > 0)
return ( SvPVX(sv) ) ;
else
- return Nullch ;
+ return NULL ;
}
else
return (sv_gets(sv, fp, append));
STATIC HV *
S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
{
+ dVAR;
GV *gv;
if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
if (len > 2 &&
(pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
- (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV)))
+ (gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVHV)))
{
return GvHV(gv); /* Foo:: */
}
/* use constant CLASS => 'MyClass' */
- if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) {
+ if ((gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV))) {
SV *sv;
if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
pkgname = SvPV_nolen_const(sv);
}
STATIC char *
-S_tokenize_use(int is_use, char *s) {
+S_tokenize_use(pTHX_ int is_use, char *s) {
+ dVAR;
if (PL_expect != XSTATE)
yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
is_use ? "use" : "no"));
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
s = force_version(s, TRUE);
- if (*s == ';' || (s = skipspace(s), *s == ';')) {
- PL_nextval[PL_nexttoke].opval = Nullop;
+ if (*s == ';' || (s = SKIPSPACE1(s), *s == ';')) {
+ NEXTVAL_NEXTTOKE.opval = NULL;
force_next(WORD);
}
else if (*s == 'v') {
int
Perl_yylex(pTHX)
{
+ dVAR;
register char *s = PL_bufptr;
register char *d;
- register I32 tmp;
STRLEN len;
- GV *gv = Nullgv;
- GV **gvp = 0;
bool bof = FALSE;
- I32 orig_keyword = 0;
DEBUG_T( {
- PerlIO_printf(Perl_debug_log, "### LEX_%s\n",
- lex_state_names[PL_lex_state]);
+ SV* tmp = newSVpvs("");
+ PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n",
+ (IV)CopLINE(PL_curcop),
+ lex_state_names[PL_lex_state],
+ exp_name[PL_expect],
+ pv_display(tmp, s, strlen(s), 0, 60));
+ SvREFCNT_dec(tmp);
} );
/* check if there's an identifier for us to look at */
if (PL_pending_ident)
/* when we've already built the next token, just pull it out of the queue */
case LEX_KNOWNEXT:
PL_nexttoke--;
- yylval = PL_nextval[PL_nexttoke];
+ yylval = NEXTVAL_NEXTTOKE;
if (!PL_nexttoke) {
PL_lex_state = PL_lex_defer;
PL_expect = PL_lex_expect;
PL_lex_defer = LEX_NORMAL;
}
- DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr,
- (IV)PL_nexttype[PL_nexttoke]); });
-
return REPORT(PL_nexttype[PL_nexttoke]);
/* interpolated case modifiers like \L \U, including \Q and \E.
}
else {
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Saw case modifier at '%s'\n", PL_bufptr); });
+ "### Saw case modifier\n"); });
s = PL_bufptr + 1;
if (s[1] == '\\' && s[2] == 'E') {
PL_bufptr = s + 3;
return yylex();
}
else {
+ I32 tmp;
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = (char)tmp; /* misordered... */
if ((*s == 'L' || *s == 'U') &&
PL_lex_casestack[PL_lex_casemods++] = *s;
PL_lex_casestack[PL_lex_casemods] = '\0';
PL_lex_state = LEX_INTERPCONCAT;
- PL_nextval[PL_nexttoke].ival = 0;
+ NEXTVAL_NEXTTOKE.ival = 0;
force_next('(');
if (*s == 'l')
- PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
+ NEXTVAL_NEXTTOKE.ival = OP_LCFIRST;
else if (*s == 'u')
- PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
+ NEXTVAL_NEXTTOKE.ival = OP_UCFIRST;
else if (*s == 'L')
- PL_nextval[PL_nexttoke].ival = OP_LC;
+ NEXTVAL_NEXTTOKE.ival = OP_LC;
else if (*s == 'U')
- PL_nextval[PL_nexttoke].ival = OP_UC;
+ NEXTVAL_NEXTTOKE.ival = OP_UC;
else if (*s == 'Q')
- PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
+ NEXTVAL_NEXTTOKE.ival = OP_QUOTEMETA;
else
Perl_croak(aTHX_ "panic: yylex");
PL_bufptr = s + 1;
if (PL_bufptr == PL_bufend)
return REPORT(sublex_done());
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Interpolated variable at '%s'\n", PL_bufptr); });
+ "### Interpolated variable\n"); });
PL_expect = XTERM;
PL_lex_dojoin = (*PL_bufptr == '@');
PL_lex_state = LEX_INTERPNORMAL;
if (PL_lex_dojoin) {
- PL_nextval[PL_nexttoke].ival = 0;
+ NEXTVAL_NEXTTOKE.ival = 0;
force_next(',');
force_ident("\"", '$');
- PL_nextval[PL_nexttoke].ival = 0;
+ NEXTVAL_NEXTTOKE.ival = 0;
force_next('$');
- PL_nextval[PL_nexttoke].ival = 0;
+ NEXTVAL_NEXTTOKE.ival = 0;
force_next('(');
- PL_nextval[PL_nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
+ NEXTVAL_NEXTTOKE.ival = OP_JOIN; /* emulate join($", ...) */
force_next(FUNC);
}
if (PL_lex_starts++) {
{
if (PL_bufptr != PL_bufend)
Perl_croak(aTHX_ "Bad evalled substitution pattern");
- PL_lex_repl = Nullsv;
+ PL_lex_repl = NULL;
}
/* FALLTHROUGH */
case LEX_INTERPCONCAT:
}
if (s != PL_bufptr) {
- PL_nextval[PL_nexttoke] = yylval;
+ NEXTVAL_NEXTTOKE = yylval;
PL_expect = XTERM;
force_next(THING);
if (PL_lex_starts++) {
s = PL_bufptr;
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
- DEBUG_T( {
- PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at [%s]\n",
- exp_name[PL_expect], s);
- } );
retry:
switch (*s) {
PL_last_uni = 0;
PL_last_lop = 0;
if (PL_lex_brackets) {
- if (PL_lex_formbrack)
- yyerror("Format not terminated");
- else
- yyerror("Missing right curly or square bracket");
+ yyerror(PL_lex_formbrack
+ ? "Format not terminated"
+ : "Missing right curly or square bracket");
}
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Tokener got EOF\n");
PL_preambled = TRUE;
sv_setpv(PL_linestr,incl_perldb());
if (SvCUR(PL_linestr))
- sv_catpvn(PL_linestr,";", 1);
+ sv_catpvs(PL_linestr,";");
if (PL_preambleav){
while(AvFILLp(PL_preambleav) >= 0) {
SV *tmpsv = av_shift(PL_preambleav);
sv_catsv(PL_linestr, tmpsv);
- sv_catpvn(PL_linestr, ";", 1);
+ sv_catpvs(PL_linestr, ";");
sv_free(tmpsv);
}
sv_free((SV*)PL_preambleav);
PL_preambleav = NULL;
}
if (PL_minus_n || PL_minus_p) {
- sv_catpv(PL_linestr, "LINE: while (<>) {");
+ sv_catpvs(PL_linestr, "LINE: while (<>) {");
if (PL_minus_l)
- sv_catpv(PL_linestr,"chomp;");
+ sv_catpvs(PL_linestr,"chomp;");
if (PL_minus_a) {
if (PL_minus_F) {
if ((*PL_splitstr == '/' || *PL_splitstr == '\''
else {
/* "q\0${splitstr}\0" is legal perl. Yes, even NUL
bytes can be used as quoting characters. :-) */
- /* The count here deliberately includes the NUL
- that terminates the C string constant. This
- embeds the opening NUL into the string. */
const char *splits = PL_splitstr;
- sv_catpvn(PL_linestr, "our @F=split(q", 15);
+ sv_catpvs(PL_linestr, "our @F=split(q\0");
do {
/* Need to \ \s */
if (*splits == '\\')
/* This loop will embed the trailing NUL of
PL_linestr as the last thing it does before
terminating. */
- sv_catpvn(PL_linestr, ");", 2);
+ sv_catpvs(PL_linestr, ");");
}
}
else
- sv_catpv(PL_linestr,"our @F=split(' ');");
+ sv_catpvs(PL_linestr,"our @F=split(' ');");
}
}
- sv_catpvn(PL_linestr, "\n", 1);
+ if (PL_minus_E)
+ sv_catpvs(PL_linestr,"use feature ':5.10';");
+ sv_catpvs(PL_linestr, "\n");
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;
+ PL_last_lop = PL_last_uni = NULL;
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = NEWSV(85,0);
+ SV * const sv = newSV(0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
}
do {
bof = PL_rsfp ? TRUE : FALSE;
- if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
+ if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == NULL) {
fake_eof:
if (PL_rsfp) {
if (PL_preprocess && !PL_in_eval)
PerlIO_clearerr(PL_rsfp);
else
(void)PerlIO_close(PL_rsfp);
- PL_rsfp = Nullfp;
+ PL_rsfp = NULL;
PL_doextract = FALSE;
}
if (!PL_in_eval && (PL_minus_n || 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 = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
PL_minus_n = PL_minus_p = 0;
goto retry;
}
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
sv_setpvn(PL_linestr,"",0);
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
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;
+ PL_last_lop = PL_last_uni = NULL;
PL_doextract = FALSE;
}
}
} while (PL_doextract);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = NEWSV(85,0);
+ SV * const sv = newSV(0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
if (CopLINE(PL_curcop) == 1) {
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
s++;
- d = Nullch;
+ d = NULL;
if (!PL_in_eval) {
if (*s == '#' && *(s+1) == '!')
d = s + 2;
* at least, set argv[0] to the basename of the Perl
* interpreter. So, having found "#!", we'll set it right.
*/
- SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
+ SV * const x = GvSV(gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL,
+ SVt_PV)); /* $^X */
assert(SvPOK(x) || SvGMAGICAL(x));
if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
}
}
if (d < ipath)
- d = Nullch;
+ d = NULL;
}
#endif
}
while (*c && !strchr("; \t\r\n\f\v#", *c))
c++;
if (c < d)
- d = Nullch; /* "perl" not in first word; ignore */
+ d = NULL; /* "perl" not in first word; ignore */
else
*s = '#'; /* Don't try to parse shebang line */
}
}
#endif
if (d) {
- 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++ == '-') {
const bool switches_done = PL_doswitches;
+ const U32 oldpdb = PL_perldb;
+ const bool oldn = PL_minus_n;
+ const bool oldp = PL_minus_p;
+
do {
if (*d == 'M' || *d == 'm' || *d == 'C') {
const char * const m = d;
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;
+ PL_last_lop = PL_last_uni = NULL;
PL_preambled = FALSE;
if (PERLDB_LINE)
(void)gv_fetchfile(PL_origfilename);
goto retry;
}
- if (PL_doswitches && !switches_done) {
- int argc = PL_origargc;
- char **argv = PL_origargv;
- do {
- argc--,argv++;
- } while (argc && argv[0][0] == '-' && argv[0][1]);
- init_argv_symbols(argc,argv);
- }
}
}
}
CopLINE_dec(PL_curcop);
incline(s);
}
- d = PL_bufend;
- while (s < d && *s != '\n')
- s++;
- if (s < d)
- s++;
- else if (s > d) /* Found by Ilya: feed random input to Perl. */
- Perl_croak(aTHX_ "panic: input overflow");
+ d = s;
+ while (d < PL_bufend && *d != '\n')
+ d++;
+ if (d < PL_bufend)
+ d++;
+ else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */
+ Perl_croak(aTHX_ "panic: input overflow");
+ s = d;
incline(s);
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_bufptr = s;
case '-':
if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
I32 ftst = 0;
+ char tmp;
s++;
PL_bufptr = s;
if (strnEQ(s,"=>",2)) {
s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw unary minus before =>, forcing word '%s'\n", s);
+ DEBUG_T( { S_printbuf(aTHX_
+ "### Saw unary minus before =>, forcing word %s\n", s);
} );
OPERATOR('-'); /* unary minus */
}
case 'T': ftst = OP_FTTEXT; break;
case 'B': ftst = OP_FTBINARY; break;
case 'M': case 'A': case 'C':
- gv_fetchpv("\024",TRUE, SVt_PV);
+ gv_fetchpvs("\024", GV_ADD|GV_NOTQUAL, SVt_PV);
switch (tmp) {
case 'M': ftst = OP_FTMTIME; break;
case 'A': ftst = OP_FTATIME; break;
if (ftst) {
PL_last_lop_op = (OPCODE)ftst;
DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw file test %c\n", (int)ftst);
+ "### Saw file test %c\n", (int)tmp);
} );
FTST(ftst);
}
s = --PL_bufptr;
}
}
- tmp = *s++;
- if (*s == tmp) {
- s++;
+ {
+ const char tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ if (PL_expect == XOPERATOR)
+ TERM(POSTDEC);
+ else
+ OPERATOR(PREDEC);
+ }
+ else if (*s == '>') {
+ s++;
+ s = SKIPSPACE1(s);
+ if (isIDFIRST_lazy_if(s,UTF)) {
+ s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+ TOKEN(ARROW);
+ }
+ else if (*s == '$')
+ OPERATOR(ARROW);
+ else
+ TERM(ARROW);
+ }
if (PL_expect == XOPERATOR)
- TERM(POSTDEC);
- else
- OPERATOR(PREDEC);
- }
- else if (*s == '>') {
- s++;
- s = skipspace(s);
- if (isIDFIRST_lazy_if(s,UTF)) {
- s = force_word(s,METHOD,FALSE,TRUE,FALSE);
- TOKEN(ARROW);
+ Aop(OP_SUBTRACT);
+ else {
+ if (isSPACE(*s) || !isSPACE(*PL_bufptr))
+ check_uni();
+ OPERATOR('-'); /* unary minus */
}
- else if (*s == '$')
- OPERATOR(ARROW);
- else
- TERM(ARROW);
- }
- if (PL_expect == XOPERATOR)
- Aop(OP_SUBTRACT);
- else {
- if (isSPACE(*s) || !isSPACE(*PL_bufptr))
- check_uni();
- OPERATOR('-'); /* unary minus */
}
case '+':
- tmp = *s++;
- if (*s == tmp) {
- s++;
+ {
+ const char tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ if (PL_expect == XOPERATOR)
+ TERM(POSTINC);
+ else
+ OPERATOR(PREINC);
+ }
if (PL_expect == XOPERATOR)
- TERM(POSTINC);
- else
- OPERATOR(PREINC);
- }
- if (PL_expect == XOPERATOR)
- Aop(OP_ADD);
- else {
- if (isSPACE(*s) || !isSPACE(*PL_bufptr))
- check_uni();
- OPERATOR('+');
+ Aop(OP_ADD);
+ else {
+ if (isSPACE(*s) || !isSPACE(*PL_bufptr))
+ check_uni();
+ OPERATOR('+');
+ }
}
case '*':
PL_lex_brackets++;
/* FALL THROUGH */
case '~':
+ if (s[1] == '~'
+ && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
+ && FEATURE_IS_ENABLED("~~"))
+ {
+ s += 2;
+ Eop(OP_SMARTMATCH);
+ }
case ',':
- tmp = *s++;
- OPERATOR(tmp);
+ {
+ const char tmp = *s++;
+ OPERATOR(tmp);
+ }
case ':':
if (s[1] == ':') {
len = 0;
- goto just_a_word;
+ goto just_a_word_zero_gv;
}
s++;
switch (PL_expect) {
case XATTRTERM:
PL_expect = XTERMBLOCK;
grabattrs:
- s = skipspace(s);
- attrs = Nullop;
+ s = PEEKSPACE(s);
+ attrs = NULL;
while (isIDFIRST_lazy_if(s,UTF)) {
+ I32 tmp;
d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
if (tmp < 0) tmp = -tmp;
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0, sv));
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
}
else {
if (len == 6 && strnEQ(s, "unique", len)) {
#ifdef USE_ITHREADS
GvUNIQUE_on(cGVOPx_gv(yylval.opval));
#else
- ; /* skip to avoid loading attributes.pm */
+ /*EMPTY*/; /* skip to avoid loading attributes.pm */
#endif
else
Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables");
newSVOP(OP_CONST, 0,
newSVpvn(s, len)));
}
- s = skipspace(d);
+ s = PEEKSPACE(d);
if (*s == ':' && s[1] != ':')
- s = skipspace(s+1);
+ s = PEEKSPACE(s+1);
else if (s == d)
break; /* require real whitespace or :'s */
+ /* XXX losing whitespace on sequential attributes here */
}
- tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */
- if (*s != ';' && *s != '}' && *s != tmp && (tmp != '=' || *s != ')')) {
- const char q = ((*s == '\'') ? '"' : '\'');
- /* If here for an expression, and parsed no attrs, back off. */
- if (tmp == '=' && !attrs) {
- s = PL_bufptr;
- break;
+ {
+ const char tmp
+ = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */
+ if (*s != ';' && *s != '}' && *s != tmp
+ && (tmp != '=' || *s != ')')) {
+ const char q = ((*s == '\'') ? '"' : '\'');
+ /* If here for an expression, and parsed no attrs, back
+ off. */
+ if (tmp == '=' && !attrs) {
+ s = PL_bufptr;
+ break;
+ }
+ /* MUST advance bufptr here to avoid bogus "at end of line"
+ 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" );
+ if (attrs)
+ op_free(attrs);
+ OPERATOR(':');
}
- /* MUST advance bufptr here to avoid bogus "at end of line"
- context messages from yyerror().
- */
- PL_bufptr = s;
- if (!*s)
- yyerror("Unterminated attribute list");
- else
- yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list",
- q, *s, q));
- if (attrs)
- op_free(attrs);
- OPERATOR(':');
}
got_attrs:
if (attrs) {
- PL_nextval[PL_nexttoke].opval = attrs;
+ NEXTVAL_NEXTTOKE.opval = attrs;
force_next(THING);
}
TOKEN(COLONATTR);
PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
else
PL_expect = XTERM;
- s = skipspace(s);
+ s = SKIPSPACE1(s);
TOKEN('(');
case ';':
CLINE;
- tmp = *s++;
- OPERATOR(tmp);
+ {
+ const char tmp = *s++;
+ OPERATOR(tmp);
+ }
case ')':
- tmp = *s++;
- s = skipspace(s);
- if (*s == '{')
- PREBLOCK(tmp);
- TERM(tmp);
+ {
+ const char tmp = *s++;
+ s = SKIPSPACE1(s);
+ if (*s == '{')
+ PREBLOCK(tmp);
+ TERM(tmp);
+ }
case ']':
s++;
if (PL_lex_brackets <= 0)
PL_lex_brackstack[PL_lex_brackets++] = XTERM;
else
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (*s == '}') {
if (PL_expect == XREF && PL_lex_state == LEX_INTERPNORMAL) {
PL_expect = XTERM;
TOKEN(';');
case '&':
s++;
- tmp = *s++;
- if (tmp == '&')
+ if (*s++ == '&')
AOPERATOR(ANDAND);
s--;
if (PL_expect == XOPERATOR) {
case '|':
s++;
- tmp = *s++;
- if (tmp == '|')
+ if (*s++ == '|')
AOPERATOR(OROR);
s--;
BOop(OP_BIT_OR);
case '=':
s++;
- tmp = *s++;
- if (tmp == '=')
- Eop(OP_EQ);
- if (tmp == '>')
- OPERATOR(',');
- if (tmp == '~')
- PMop(OP_MATCH);
- if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX) && strchr("+-*/%.^&|<",tmp))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Reversed %c= operator",(int)tmp);
- s--;
- if (PL_expect == XSTATE && isALPHA(tmp) &&
- (s == PL_linestart+1 || s[-2] == '\n') )
{
- if (PL_in_eval && !PL_rsfp) {
- d = PL_bufend;
- while (s < d) {
- if (*s++ == '\n') {
- incline(s);
- if (strnEQ(s,"=cut",4)) {
- s = strchr(s,'\n');
- if (s)
- s++;
- else
- s = d;
- incline(s);
- goto retry;
+ const char tmp = *s++;
+ if (tmp == '=')
+ Eop(OP_EQ);
+ if (tmp == '>')
+ OPERATOR(',');
+ if (tmp == '~')
+ PMop(OP_MATCH);
+ if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX)
+ && strchr("+-*/%.^&|<",tmp))
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Reversed %c= operator",(int)tmp);
+ s--;
+ if (PL_expect == XSTATE && isALPHA(tmp) &&
+ (s == PL_linestart+1 || s[-2] == '\n') )
+ {
+ if (PL_in_eval && !PL_rsfp) {
+ d = PL_bufend;
+ while (s < d) {
+ if (*s++ == '\n') {
+ incline(s);
+ if (strnEQ(s,"=cut",4)) {
+ s = strchr(s,'\n');
+ if (s)
+ s++;
+ else
+ s = d;
+ incline(s);
+ goto retry;
+ }
+ }
}
+ goto retry;
}
+ s = PL_bufend;
+ PL_doextract = TRUE;
+ goto retry;
}
- goto retry;
- }
- s = PL_bufend;
- PL_doextract = TRUE;
- goto retry;
}
if (PL_lex_brackets < PL_lex_formbrack) {
const char *t;
OPERATOR(ASSIGNOP);
case '!':
s++;
- tmp = *s++;
- if (tmp == '=') {
- /* was this !=~ where !~ was meant?
- * warn on m:!=~\s+([/?]|[msy]\W|tr\W): */
-
- if (*s == '~' && ckWARN(WARN_SYNTAX)) {
- const char *t = s+1;
-
- while (t < PL_bufend && isSPACE(*t))
- ++t;
-
- if (*t == '/' || *t == '?' ||
- ((*t == 'm' || *t == 's' || *t == 'y') && !isALNUM(t[1])) ||
- (*t == 't' && t[1] == 'r' && !isALNUM(t[2])))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "!=~ should be !~");
- }
- Eop(OP_NE);
- }
- if (tmp == '~')
- PMop(OP_NOT);
+ {
+ const char tmp = *s++;
+ if (tmp == '=') {
+ /* was this !=~ where !~ was meant?
+ * warn on m:!=~\s+([/?]|[msy]\W|tr\W): */
+
+ if (*s == '~' && ckWARN(WARN_SYNTAX)) {
+ const char *t = s+1;
+
+ while (t < PL_bufend && isSPACE(*t))
+ ++t;
+
+ if (*t == '/' || *t == '?' ||
+ ((*t == 'm' || *t == 's' || *t == 'y')
+ && !isALNUM(t[1])) ||
+ (*t == 't' && t[1] == 'r' && !isALNUM(t[2])))
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "!=~ should be !~");
+ }
+ Eop(OP_NE);
+ }
+ if (tmp == '~')
+ PMop(OP_NOT);
+ }
s--;
OPERATOR('!');
case '<':
TERM(sublex_start());
}
s++;
- tmp = *s++;
- if (tmp == '<')
- SHop(OP_LEFT_SHIFT);
- if (tmp == '=') {
- tmp = *s++;
- if (tmp == '>')
- Eop(OP_NCMP);
- s--;
- Rop(OP_LE);
+ {
+ char tmp = *s++;
+ if (tmp == '<')
+ SHop(OP_LEFT_SHIFT);
+ if (tmp == '=') {
+ tmp = *s++;
+ if (tmp == '>')
+ Eop(OP_NCMP);
+ s--;
+ Rop(OP_LE);
+ }
}
s--;
Rop(OP_LT);
case '>':
s++;
- tmp = *s++;
- if (tmp == '>')
- SHop(OP_RIGHT_SHIFT);
- if (tmp == '=')
- Rop(OP_GE);
+ {
+ const char tmp = *s++;
+ if (tmp == '>')
+ SHop(OP_RIGHT_SHIFT);
+ if (tmp == '=')
+ Rop(OP_GE);
+ }
s--;
Rop(OP_GT);
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
}
}
d = s;
- tmp = (I32)*s;
- if (PL_lex_state == LEX_NORMAL)
- s = skipspace(s);
-
- if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
- if (*s == '[') {
- PL_tokenbuf[0] = '@';
- if (ckWARN(WARN_SYNTAX)) {
- char *t;
- for(t = s + 1;
- isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
- t++) ;
- if (*t++ == ',') {
- PL_bufptr = skipspace(PL_bufptr);
- while (t < PL_bufend && *t != ']')
- t++;
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Multidimensional syntax %.*s not supported",
- (t - PL_bufptr) + 1, PL_bufptr);
- }
- }
- }
- else if (*s == '{') {
- char *t;
- PL_tokenbuf[0] = '%';
- if (strEQ(PL_tokenbuf+1, "SIG") && ckWARN(WARN_SYNTAX)
- && (t = strchr(s, '}')) && (t = strchr(t, '=')))
- {
- char tmpbuf[sizeof PL_tokenbuf];
- 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))
+ {
+ const char tmp = *s;
+ if (PL_lex_state == LEX_NORMAL)
+ s = SKIPSPACE1(s);
+
+ if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
+ && intuit_more(s)) {
+ if (*s == '[') {
+ PL_tokenbuf[0] = '@';
+ if (ckWARN(WARN_SYNTAX)) {
+ char *t;
+ for(t = s + 1;
+ isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
+ t++) ;
+ if (*t++ == ',') {
+ PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
+ while (t < PL_bufend && *t != ']')
+ t++;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "You need to quote \"%s\"", tmpbuf);
+ "Multidimensional syntax %.*s not supported",
+ (int)((t - PL_bufptr) + 1), PL_bufptr);
+ }
}
}
+ else if (*s == '{') {
+ char *t;
+ PL_tokenbuf[0] = '%';
+ if (strEQ(PL_tokenbuf+1, "SIG") && ckWARN(WARN_SYNTAX)
+ && (t = strchr(s, '}')) && (t = strchr(t, '=')))
+ {
+ char tmpbuf[sizeof PL_tokenbuf];
+ for (t++; isSPACE(*t); t++) ;
+ if (isIDFIRST_lazy_if(t,UTF)) {
+ STRLEN dummylen;
+ t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE,
+ &dummylen);
+ for (; isSPACE(*t); t++) ;
+ if (*t == ';' && get_cv(tmpbuf, FALSE))
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "You need to quote \"%s\"",
+ tmpbuf);
+ }
+ }
+ }
}
- }
- PL_expect = XOPERATOR;
- if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
- const bool islop = (PL_last_lop == PL_oldoldbufptr);
- if (!islop || PL_last_lop_op == OP_GREPSTART)
- PL_expect = XOPERATOR;
- else if (strchr("$@\"'`q", *s))
- PL_expect = XTERM; /* e.g. print $fh "foo" */
- else if (strchr("&*<%", *s) && isIDFIRST_lazy_if(s+1,UTF))
- PL_expect = XTERM; /* e.g. print $fh &sub */
- else if (isIDFIRST_lazy_if(s,UTF)) {
- char tmpbuf[sizeof PL_tokenbuf];
- scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if ((tmp = keyword(tmpbuf, len))) {
- /* binary operators exclude handle interpretations */
- switch (tmp) {
- case -KEY_x:
- case -KEY_eq:
- case -KEY_ne:
- case -KEY_gt:
- case -KEY_lt:
- case -KEY_ge:
- case -KEY_le:
- case -KEY_cmp:
- break;
- default:
- PL_expect = XTERM; /* e.g. print $fh length() */
- break;
+ PL_expect = XOPERATOR;
+ if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
+ const bool islop = (PL_last_lop == PL_oldoldbufptr);
+ if (!islop || PL_last_lop_op == OP_GREPSTART)
+ PL_expect = XOPERATOR;
+ else if (strchr("$@\"'`q", *s))
+ PL_expect = XTERM; /* e.g. print $fh "foo" */
+ else if (strchr("&*<%", *s) && isIDFIRST_lazy_if(s+1,UTF))
+ PL_expect = XTERM; /* e.g. print $fh &sub */
+ else if (isIDFIRST_lazy_if(s,UTF)) {
+ char tmpbuf[sizeof PL_tokenbuf];
+ int t2;
+ scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
+ if ((t2 = keyword(tmpbuf, len))) {
+ /* binary operators exclude handle interpretations */
+ switch (t2) {
+ case -KEY_x:
+ case -KEY_eq:
+ case -KEY_ne:
+ case -KEY_gt:
+ case -KEY_lt:
+ case -KEY_ge:
+ case -KEY_le:
+ case -KEY_cmp:
+ break;
+ default:
+ PL_expect = XTERM; /* e.g. print $fh length() */
+ break;
+ }
+ }
+ else {
+ PL_expect = XTERM; /* e.g. print $fh subr() */
}
}
- else {
- PL_expect = XTERM; /* e.g. print $fh subr() */
- }
+ else if (isDIGIT(*s))
+ PL_expect = XTERM; /* e.g. print $fh 3 */
+ else if (*s == '.' && isDIGIT(s[1]))
+ PL_expect = XTERM; /* e.g. print $fh .3 */
+ else if ((*s == '?' || *s == '-' || *s == '+')
+ && !isSPACE(s[1]) && s[1] != '=')
+ PL_expect = XTERM; /* e.g. print $fh -1 */
+ else if (*s == '/' && !isSPACE(s[1]) && s[1] != '='
+ && s[1] != '/')
+ PL_expect = XTERM; /* e.g. print $fh /.../
+ XXX except DORDOR operator
+ */
+ else if (*s == '<' && s[1] == '<' && !isSPACE(s[2])
+ && s[2] != '=')
+ PL_expect = XTERM; /* print $fh <<"EOF" */
}
- else if (isDIGIT(*s))
- PL_expect = XTERM; /* e.g. print $fh 3 */
- else if (*s == '.' && isDIGIT(s[1]))
- PL_expect = XTERM; /* e.g. print $fh .3 */
- else if ((*s == '?' || *s == '-' || *s == '+')
- && !isSPACE(s[1]) && s[1] != '=')
- PL_expect = XTERM; /* e.g. print $fh -1 */
- else if (*s == '/' && !isSPACE(s[1]) && s[1] != '=' && s[1] != '/')
- PL_expect = XTERM; /* e.g. print $fh /.../
- XXX except DORDOR operator */
- else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
- PL_expect = XTERM; /* print $fh <<"EOF" */
}
PL_pending_ident = '$';
TOKEN('$');
PREREF('@');
}
if (PL_lex_state == LEX_NORMAL)
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
if (*s == '{')
PL_tokenbuf[0] = '%';
t++;
if (*t == '}' || *t == ']') {
t++;
- PL_bufptr = skipspace(PL_bufptr);
+ PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Scalar value %.*s better written as $%.*s",
- t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
+ (int)(t-PL_bufptr), PL_bufptr,
+ (int)(t-PL_bufptr-1), PL_bufptr+1);
}
}
}
}
case '?': /* may either be conditional or pattern */
if(PL_expect == XOPERATOR) {
- tmp = *s++;
+ char tmp = *s++;
if(tmp == '?') {
OPERATOR('?');
}
goto rightbracket;
}
if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
- tmp = *s++;
+ char tmp = *s++;
if (*s == tmp) {
s++;
if (*s == tmp) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
s = scan_num(s, &yylval);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw number in '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw number in %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
case '\'':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
else
case '"':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
else
case '`':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw backtick string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw backtick string before %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
const char c = *start;
GV *gv;
*start = '\0';
- gv = gv_fetchpv(s, FALSE, SVt_PVCV);
+ gv = gv_fetchpv(s, 0, SVt_PVCV);
*start = c;
if (!gv) {
s = scan_num(s, &yylval);
case 'z': case 'Z':
keylookup: {
- orig_keyword = 0;
- gv = Nullgv;
- gvp = 0;
+ I32 tmp;
+ I32 orig_keyword = 0;
+ GV *gv = NULL;
+ GV **gvp = NULL;
PL_bufptr = s;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
}
if (tmp < 0) { /* second-class keyword? */
- GV *ogv = Nullgv; /* override (winner) */
- GV *hgv = Nullgv; /* hidden (loser) */
+ GV *ogv = NULL; /* override (winner) */
+ GV *hgv = NULL; /* hidden (loser) */
if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
CV *cv;
- if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
+ if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVCV)) &&
(cv = GvCVu(gv)))
{
if (GvIMPORTED_CV(gv))
else if (gv && !gvp
&& -tmp==KEY_lock /* XXX generalizable kludge */
&& GvCVu(gv)
- && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
+ && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE))
{
tmp = 0; /* any sub overrides "weak" keyword */
}
- else if (gv && !gvp
- && tmp == -KEY_err
- && GvCVu(gv)
- && PL_expect != XOPERATOR
- && PL_expect != XTERMORDORDOR)
- {
- /* any sub overrides the "err" keyword, except when really an
- * operator is expected */
- tmp = 0;
- }
else { /* no override */
tmp = -tmp;
if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
Perl_warner(aTHX_ packWARN(WARN_MISC),
"dump() better written as CORE::dump()");
}
- gv = Nullgv;
+ gv = NULL;
gvp = 0;
if (hgv && tmp != KEY_x && tmp != KEY_CORE
&& ckWARN(WARN_AMBIGUOUS)) /* never ambiguous */
switch (tmp) {
default: /* not a keyword */
+ /* Trade off - by using this evil construction we can pull the
+ variable gv into the block labelled keylookup. If not, then
+ we have to give it function scope so that the goto from the
+ earlier ':' case doesn't bypass the initialisation. */
+ if (0) {
+ just_a_word_zero_gv:
+ gv = NULL;
+ gvp = NULL;
+ orig_keyword = 0;
+ }
just_a_word: {
SV *sv;
int pkgname = 0;
const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
+ CV *cv;
/* Get the rest if it looks like a package qualifier */
if (len > 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ if (ckWARN(WARN_BAREWORD)
+ && ! gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVHV))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
len -= 2;
PL_tokenbuf[len] = '\0';
- gv = Nullgv;
+ gv = NULL;
gvp = 0;
}
else {
+ if (!gv) {
+ /* Mustn't actually add anything to a symbol table.
+ But also don't want to "initialise" any placeholder
+ constants that might already be there into full
+ blown PVGVs with attached PVCV. */
+ gv = gv_fetchpvn_flags(PL_tokenbuf, len,
+ GV_NOADD_NOINIT, SVt_PVCV);
+ }
len = 0;
- if (!gv)
- gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
}
/* if we saw a global override before, get the right name */
if (gvp) {
- sv = newSVpvn("CORE::GLOBAL::",14);
+ sv = newSVpvs("CORE::GLOBAL::");
sv_catpv(sv,PL_tokenbuf);
}
else {
if (len)
goto safe_bareword;
+ /* Do the explicit type check so that we don't need to force
+ the initialisation of the symbol table to have a real GV.
+ Beware - gv may not really be a PVGV, cv may not really be
+ a PVCV, (because of the space optimisations that gv_init
+ understands) But they're true if for this symbol there is
+ respectively a typeglob and a subroutine.
+ */
+ cv = gv ? ((SvTYPE(gv) == SVt_PVGV)
+ /* Real typeglob, so get the real subroutine: */
+ ? GvCVu(gv)
+ /* A proxy for a subroutine in this package? */
+ : SvOK(gv) ? (CV *) gv : NULL)
+ : NULL;
+
/* See if it's the indirect object for a list operator. */
if (PL_oldoldbufptr &&
bool immediate_paren = *s == '(';
/* (Now we can afford to cross potential line boundary.) */
- s = skipspace(s);
+ s = SKIPSPACE2(s,nextnextwhite);
/* Two barewords in a row may indicate method call. */
- if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp=intuit_method(s,gv)))
+ if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
+ (tmp = intuit_method(s, gv, cv)))
return REPORT(tmp);
/* If not a declared subroutine, it's an indirect object. */
/* (But it's an indir obj regardless for sort.) */
+ /* Also, if "_" follows a filetest operator, it's a bareword */
- if ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
- ((!gv || !GvCVu(gv)) &&
+ if (
+ ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
+ ((!gv || !cv) &&
(PL_last_lop_op != OP_MAPSTART &&
PL_last_lop_op != OP_GREPSTART))))
+ || (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
+ && ((PL_opargs[PL_last_lop_op] & OA_CLASS_MASK) == OA_FILESTATOP))
+ )
{
PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
goto bareword;
/* If followed by a paren, it's certainly a subroutine. */
if (*s == '(') {
CLINE;
- if (gv && GvCVu(gv)) {
+ if (cv) {
for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
- if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+ if (*d == ')' && (sv = gv_const_sv(gv))) {
s = d + 1;
goto its_constant;
}
}
- PL_nextval[PL_nexttoke].opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = yylval.opval;
PL_expect = XOPERATOR;
force_next(WORD);
yylval.ival = 0;
/* If followed by var or block, call it a method (unless sub) */
- if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
+ if ((*s == '$' || *s == '{') && (!gv || !cv)) {
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
if (!orig_keyword
&& (isIDFIRST_lazy_if(s,UTF) || *s == '$')
- && (tmp = intuit_method(s,gv)))
+ && (tmp = intuit_method(s, gv, cv)))
return REPORT(tmp);
/* Not a method, so call it a subroutine (if defined) */
- if (gv && GvCVu(gv)) {
- CV* cv;
+ if (cv) {
if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS))
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
- cv = GvCV(gv);
- if ((sv = cv_const_sv(cv))) {
+ if ((sv = gv_const_sv(gv))) {
its_constant:
SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
- ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
+ ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
yylval.opval->op_private = 0;
TOKEN(WORD);
}
/* Resolve to GV now. */
+ if (SvTYPE(gv) != SVt_PVGV) {
+ gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
+ assert (SvTYPE(gv) == SVt_PVGV);
+ /* cv must have been some sort of placeholder, so
+ now needs replacing with a real code reference. */
+ cv = GvCV(gv);
+ }
+
op_free(yylval.opval);
yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop_op = OP_ENTERSUB;
/* Is there a prototype? */
if (SvPOK(cv)) {
- STRLEN len;
- const char *proto = SvPV_const((SV*)cv, len);
- if (!len)
+ STRLEN protolen;
+ const char *proto = SvPV_const((SV*)cv, protolen);
+ if (!protolen)
TERM(FUNC0SUB);
if (*proto == '$' && proto[1] == '\0')
OPERATOR(UNIOPSUB);
PREBLOCK(LSTOPSUB);
}
}
- PL_nextval[PL_nexttoke].opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = yylval.opval;
PL_expect = XTERM;
force_next(WORD);
TOKEN(NOAMP);
const char *pname = "main";
if (PL_tokenbuf[2] == 'D')
pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
- gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);
+ gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), GV_ADD,
+ SVt_PVIO);
GvMULTI_on(gv);
if (!GvIO(gv))
GvIOp(gv) = newIO();
}
}
#endif
- PL_rsfp = Nullfp;
+ PL_rsfp = NULL;
}
goto fake_eof;
}
Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
if (tmp < 0)
tmp = -tmp;
+ else if (tmp == KEY_require || tmp == KEY_do)
+ /* that's a way to remember we saw "CORE::" */
+ orig_keyword = tmp;
goto reserved_word;
}
goto just_a_word;
case KEY_bless:
LOP(OP_BLESS,XTERM);
+ case KEY_break:
+ FUN0(OP_BREAK);
+
case KEY_chop:
UNI(OP_CHOP);
case KEY_continue:
+ /* When 'use switch' is in effect, continue has a dual
+ life as a control operator. */
+ {
+ if (!FEATURE_IS_ENABLED("switch"))
+ PREBLOCK(CONTINUE);
+ else {
+ /* We have to disambiguate the two senses of
+ "continue". If the next token is a '{' then
+ treat it as the start of a continue block;
+ otherwise treat it as a control operator.
+ */
+ s = skipspace(s);
+ if (*s == '{')
PREBLOCK(CONTINUE);
+ else
+ FUN0(OP_CONTINUE);
+ }
+ }
case KEY_chdir:
- (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
+ /* may use HOME */
+ (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV);
UNI(OP_CHDIR);
case KEY_close:
case KEY_chroot:
UNI(OP_CHROOT);
+ case KEY_default:
+ PREBLOCK(DEFAULT);
+
case KEY_do:
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'')
s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (orig_keyword == KEY_do) {
+ orig_keyword = 0;
+ yylval.ival = 1;
+ }
+ else
+ yylval.ival = 0;
OPERATOR(DO);
case KEY_die:
UNI(OP_DELETE);
case KEY_dbmopen:
- gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
+ gv_fetchpvs("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
LOP(OP_DBMOPEN,XTERM);
case KEY_dbmclose:
UNI(OP_EXIT);
case KEY_eval:
- s = skipspace(s);
+ s = SKIPSPACE1(s);
PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
UNIBRACK(OP_ENTEREVAL);
case KEY_for:
case KEY_foreach:
yylval.ival = CopLINE(PL_curcop);
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
char *p = s;
if ((PL_bufend - p) >= 3 &&
else if ((PL_bufend - p) >= 4 &&
strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
p += 3;
- p = skipspace(p);
+ p = PEEKSPACE(p);
if (isIDFIRST_lazy_if(p,UTF)) {
p = scan_ident(p, PL_bufend,
PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
- p = skipspace(p);
+ p = PEEKSPACE(p);
}
if (*p != '$')
Perl_croak(aTHX_ "Missing $ on loop variable");
case KEY_getlogin:
FUN0(OP_GETLOGIN);
+ case KEY_given:
+ yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(GIVEN);
+
case KEY_glob:
set_csh();
LOP(OP_GLOB,XTERM);
case KEY_our:
case KEY_my:
PL_in_my = tmp;
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3))
OPERATOR(USE);
case KEY_not:
- if (*s == '(' || (s = skipspace(s), *s == '('))
+ if (*s == '(' || (s = SKIPSPACE1(s), *s == '('))
FUN1(OP_NOT);
else
OPERATOR(NOTOP);
case KEY_open:
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
const char *t;
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
/* [perl #16184] */
&& !(t[0] == '=' && t[1] == '>')
) {
+ int parms_len = (int)(d-s);
Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
"Precedence problem: open %.*s should be open(%.*s)",
- d - s, s, d - s, s);
+ parms_len, s, parms_len, s);
}
}
LOP(OP_OPEN,XTERM);
PL_expect = XOPERATOR;
force_next(')');
if (SvCUR(PL_lex_stuff)) {
- OP *words = Nullop;
+ OP *words = NULL;
int warned = 0;
d = SvPV_force(PL_lex_stuff, len);
while (len) {
}
}
if (words) {
- PL_nextval[PL_nexttoke].opval = words;
+ NEXTVAL_NEXTTOKE.opval = words;
force_next(THING);
}
}
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
}
PL_expect = XTERM;
TOKEN('(');
OLDLOP(OP_RETURN);
case KEY_require:
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (isDIGIT(*s)) {
s = force_version(s, FALSE);
}
else if (*s == '<')
yyerror("<> should be quotes");
}
- UNI(OP_REQUIRE);
+ if (orig_keyword == KEY_require) {
+ orig_keyword = 0;
+ yylval.ival = 1;
+ }
+ else
+ yylval.ival = 0;
+ PL_expect = XTERM;
+ PL_bufptr = s;
+ PL_last_uni = PL_oldbufptr;
+ PL_last_lop_op = OP_REQUIRE;
+ s = skipspace(s);
+ return REPORT( (int)REQUIRE );
case KEY_reset:
UNI(OP_RESET);
else
TOKEN(1); /* force error */
+ case KEY_say:
+ checkcomma(s,PL_tokenbuf,"filehandle");
+ LOP(OP_SAY,XREF);
+
case KEY_chomp:
UNI(OP_CHOMP);
case KEY_sort:
checkcomma(s,PL_tokenbuf,"subroutine name");
- s = skipspace(s);
+ s = SKIPSPACE1(s);
if (*s == ';' || *s == ')') /* probably a close */
Perl_croak(aTHX_ "sort is now a reserved word");
PL_expect = XTERM;
sv_setpv(PL_subname, tmpbuf);
else {
sv_setsv(PL_subname,PL_curstname);
- sv_catpvn(PL_subname,"::",2);
+ sv_catpvs(PL_subname,"::");
sv_catpvn(PL_subname,tmpbuf,len);
}
s = skipspace(d);
}
if (have_proto) {
- PL_nextval[PL_nexttoke].opval =
+ NEXTVAL_NEXTTOKE.opval =
(OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
force_next(THING);
}
if (!have_name) {
case KEY_vec:
LOP(OP_VEC,XTERM);
+ case KEY_when:
+ yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(WHEN);
+
case KEY_while:
yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
char ctl_l[2];
ctl_l[0] = toCTRL('L');
ctl_l[1] = '\0';
- gv_fetchpv(ctl_l,TRUE, SVt_PV);
+ gv_fetchpvn_flags(ctl_l, 1, GV_ADD|GV_NOTQUAL, SVt_PV);
}
#else
- gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+ /* Make sure $^L is defined */
+ gv_fetchpvs("\f", GV_ADD|GV_NOTQUAL, SVt_PV);
#endif
UNI(OP_ENTERWRITE);
static int
S_pending_ident(pTHX)
{
+ dVAR;
register char *d;
register I32 tmp = 0;
/* pit holds the identifier we read and pending_ident is reset */
PL_pending_ident = 0;
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Tokener saw identifier '%s'\n", PL_tokenbuf); });
+ "### Pending identifier '%s'\n", PL_tokenbuf); });
/* if we're in a my(), we can't allow dynamics here.
$foo'bar has already been turned into $foo::bar, so
tmp = pad_findmy(PL_tokenbuf);
if (tmp != NOT_IN_PAD) {
/* might be an "our" variable" */
- if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
+ if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
/* build ops for a bareword */
HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
HEK * const stashname = HvNAME_HEK(stash);
SV * const sym = newSVhek(stashname);
- sv_catpvn(sym, "::", 2);
+ sv_catpvs(sym, "::");
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
yylval.opval->op_private = OPpCONST_ENTERED;
table.
*/
if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
- GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
+ GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
&& ckWARN(WARN_AMBIGUOUS))
{
/* build ops for a bareword */
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
- ((PL_tokenbuf[0] == '$') ? SVt_PV
- : (PL_tokenbuf[0] == '@') ? SVt_PVAV
- : SVt_PVHV));
+ gv_fetchpv(
+ PL_tokenbuf+1,
+ /* If the identifier refers to a stash, don't autovivify it.
+ * Change 24660 had the side effect of causing symbol table
+ * hashes to always be defined, even if they were freshly
+ * created and the only reference in the entire program was
+ * the single statement with the defined %foo::bar:: test.
+ * It appears that all code in the wild doing this actually
+ * wants to know whether sub-packages have been loaded, so
+ * by avoiding auto-vivifying symbol tables, we ensure that
+ * defined %foo::bar:: continues to be false, and the existing
+ * tests still give the expected answers, even though what
+ * they're actually testing has now changed subtly.
+ */
+ (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'
+ ? 0
+ : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
return WORD;
}
I32
Perl_keyword (pTHX_ const char *name, I32 len)
{
+ dVAR;
switch (len)
{
case 1: /* 5 tokens of length 1 */
goto unknown;
}
- case 3: /* 28 tokens of length 3 */
+ case 3: /* 29 tokens of length 3 */
switch (name[0])
{
case 'E':
case 'r':
if (name[2] == 'r')
{ /* err */
- return -KEY_err;
+ return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
}
goto unknown;
case 's':
switch (name[1])
{
+ case 'a':
+ if (name[2] == 'y')
+ { /* say */
+ return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
+ }
+
+ goto unknown;
+
case 'i':
if (name[2] == 'n')
{ /* sin */
goto unknown;
}
- case 4: /* 40 tokens of length 4 */
+ case 4: /* 41 tokens of length 4 */
switch (name[0])
{
case 'C':
}
case 'w':
- if (name[1] == 'a')
+ switch (name[1])
{
+ case 'a':
switch (name[2])
{
case 'i':
default:
goto unknown;
}
+
+ case 'h':
+ if (name[2] == 'e' &&
+ name[3] == 'n')
+ { /* when */
+ return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
}
goto unknown;
goto unknown;
}
- case 5: /* 36 tokens of length 5 */
+ default:
+ goto unknown;
+ }
+
+ case 5: /* 38 tokens of length 5 */
switch (name[0])
{
case 'B':
}
case 'b':
- if (name[1] == 'l' &&
- name[2] == 'e' &&
+ switch (name[1])
+ {
+ case 'l':
+ if (name[2] == 'e' &&
name[3] == 's' &&
name[4] == 's')
{ /* bless */
goto unknown;
+ case 'r':
+ if (name[2] == 'e' &&
+ name[3] == 'a' &&
+ name[4] == 'k')
+ { /* break */
+ return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
+
case 'c':
switch (name[1])
{
goto unknown;
}
+ case 'g':
+ if (name[1] == 'i' &&
+ name[2] == 'v' &&
+ name[3] == 'e' &&
+ name[4] == 'n')
+ { /* given */
+ return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
+ }
+
+ goto unknown;
+
case 'i':
switch (name[1])
{
goto unknown;
}
- case 7: /* 28 tokens of length 7 */
+ case 7: /* 29 tokens of length 7 */
switch (name[0])
{
case 'D':
goto unknown;
case 'e':
- if (name[2] == 'f' &&
- name[3] == 'i' &&
- name[4] == 'n' &&
+ if (name[2] == 'f')
+ {
+ switch (name[3])
+ {
+ case 'a':
+ if (name[4] == 'u' &&
+ name[5] == 'l' &&
+ name[6] == 't')
+ { /* default */
+ return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
+ }
+
+ goto unknown;
+
+ case 'i':
+ if (name[4] == 'n' &&
name[5] == 'e' &&
name[6] == 'd')
{ /* defined */
default:
goto unknown;
}
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
case 'f':
if (name[1] == 'o' &&
STATIC void
S_checkcomma(pTHX_ register char *s, const char *name, const char *what)
{
+ dVAR;
const char *w;
if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ',') {
- int kw;
+ I32 kw;
*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 = ',';
/* Check the eval first */
if (!PL_in_eval && SvTRUE(ERRSV)) {
- sv_catpv(ERRSV, "Propagated");
+ sv_catpvs(ERRSV, "Propagated");
yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */
(void)POPs;
- res = SvREFCNT_inc(sv);
+ res = SvREFCNT_inc_simple(sv);
}
else {
res = POPs;
- (void)SvREFCNT_inc(res);
+ SvREFCNT_inc_simple_void(res);
}
PUTBACK ;
STATIC char *
S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
+ dVAR;
register char *d = dest;
register char * const e = d + destlen - 3; /* two-character token, ending NUL */
for (;;) {
STATIC char *
S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
- register char *d;
- register char *e;
- char *bracket = Nullch;
+ dVAR;
+ char *bracket = NULL;
char funny = *s++;
+ register char *d = dest;
+ register char * const e = d + destlen + 3; /* two-character token, ending NUL */
if (isSPACE(*s))
- s = skipspace(s);
- d = dest;
- e = d + destlen - 3; /* two-character token, ending NUL */
+ s = PEEKSPACE(s);
if (isDIGIT(*s)) {
while (isDIGIT(*s)) {
if (d >= e)
if (isIDFIRST_lazy_if(d,UTF)) {
d++;
if (UTF) {
- e = s;
- while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
- e += UTF8SKIP(e);
- while (e < send && UTF8_IS_CONTINUED(*e) && is_utf8_mark((U8*)e))
- e += UTF8SKIP(e);
+ char *end = s;
+ while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') {
+ end += UTF8SKIP(end);
+ while (end < send && UTF8_IS_CONTINUED(*end) && is_utf8_mark((U8*)end))
+ end += UTF8SKIP(end);
}
- Copy(s, d, e - s, char);
- d += e - s;
- s = e;
+ Copy(s, d, end - s, char);
+ d += end - s;
+ s = end;
}
else {
while ((isALNUM(*s) || *s == ':') && d < e)
void
Perl_pmflag(pTHX_ U32* pmfl, int ch)
{
+ PERL_UNUSED_CONTEXT;
if (ch == 'i')
*pmfl |= PMf_FOLD;
else if (ch == 'g')
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
+ dVAR;
PMOP *pm;
char *s = scan_str(start,FALSE,FALSE);
+ const char * const valid_flags = (type == OP_QR) ? "iomsx" : "iogcmsx";
if (!s) {
- char * const delimiter = skipspace(start);
+ 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" );
pm = (PMOP*)newPMOP(type, 0);
if (PL_multi_open == '?')
pm->op_pmflags |= PMf_ONCE;
- if(type == OP_QR) {
- while (*s && strchr("iomsx", *s))
- pmflag(&pm->op_pmflags,*s++);
- }
- else {
- while (*s && strchr("iogcmsx", *s))
- pmflag(&pm->op_pmflags,*s++);
- }
+ while (*s && strchr(valid_flags, *s))
+ pmflag(&pm->op_pmflags,*s++);
/* issue a warning if /c is specified,but /g is not */
if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
&& ckWARN(WARN_REGEXP))
{
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
}
pm->op_pmpermflags = pm->op_pmflags;
if (!s) {
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
}
Perl_croak(aTHX_ "Substitution replacement not terminated");
}
break;
}
- /* /c is not meaningful with s/// */
- if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
- {
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
+ if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
}
if (es) {
- SV *repl;
+ SV * const repl = newSVpvs("");
+
PL_sublex_info.super_bufptr = s;
PL_sublex_info.super_bufend = PL_bufend;
PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
- repl = newSVpvn("",0);
while (es-- > 0)
sv_catpv(repl, es ? "eval " : "do ");
- sv_catpvn(repl, "{ ", 2);
+ sv_catpvs(repl, "{");
sv_catsv(repl, PL_lex_repl);
- sv_catpvn(repl, " };", 2);
+ sv_catpvs(repl, "}");
SvEVALED_on(repl);
SvREFCNT_dec(PL_lex_repl);
PL_lex_repl = repl;
STATIC char *
S_scan_trans(pTHX_ char *start)
{
+ dVAR;
register char* s;
OP *o;
short *tbl;
if (!s) {
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
}
Perl_croak(aTHX_ "Transliteration replacement not terminated");
}
STATIC char *
S_scan_heredoc(pTHX_ register char *s)
{
+ dVAR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
SV *tmpstr;
char term;
- const char newline[] = "\n";
const char *found_newline;
register char *d;
register char *e;
s = olds;
}
#endif
- if ( outer || !(found_newline = ninstr(s,PL_bufend,newline,newline+1)) ) {
+ if ( outer || !(found_newline = memchr(s, '\n', PL_bufend - s)) ) {
herewas = newSVpvn(s,PL_bufend-s);
}
else {
}
s += SvCUR(herewas);
- tmpstr = NEWSV(87,79);
+ tmpstr = newSV(79);
sv_upgrade(tmpstr, SVt_PVIV);
if (term == '\'') {
op_type = OP_CONST;
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
- char *bufptr = PL_sublex_info.super_bufptr;
- char *bufend = PL_sublex_info.super_bufend;
+ char * const bufptr = PL_sublex_info.super_bufptr;
+ char * const bufend = PL_sublex_info.super_bufend;
char * const olds = s - SvCUR(herewas);
s = strchr(bufptr, '\n');
if (!s)
sv_setsv(PL_linestr,herewas);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
}
else
sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
}
CopLINE_inc(PL_curcop);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
PL_bufend[-1] = '\n';
#endif
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(88,0);
+ SV * const sv = newSV(0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
STATIC char *
S_scan_inputsymbol(pTHX_ char *start)
{
+ dVAR;
register char *s = start; /* current position in buffer */
- register char *d;
- const char *e;
char *end;
I32 len;
- d = PL_tokenbuf; /* start of temp holding space */
- e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
+ char *d = PL_tokenbuf; /* start of temp holding space */
+ const char * const e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
+
end = strchr(s, '\n');
if (!end)
end = PL_bufend;
}
else {
bool readline_overriden = FALSE;
- GV *gv_readline = Nullgv;
+ GV *gv_readline;
GV **gvp;
/* we're in a filehandle read situation */
d = PL_tokenbuf;
Copy("ARGV",d,5,char);
/* Check whether readline() is overriden */
- if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+ gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV);
+ if ((gv_readline
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
||
- ((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
+ ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
&& (gv_readline = *gvp) != (GV*)&PL_sv_undef
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
readline_overriden = TRUE;
add symbol table ops
*/
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
- if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
- HV *stash = PAD_COMPNAME_OURSTASH(tmp);
- HEK *stashname = HvNAME_HEK(stash);
- SV *sym = sv_2mortal(newSVhek(stashname));
- sv_catpvn(sym, "::", 2);
+ if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
+ HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
+ HEK * const stashname = HvNAME_HEK(stash);
+ SV * const sym = sv_2mortal(newSVhek(stashname));
+ sv_catpvs(sym, "::");
sv_catpv(sym, d+1);
d = SvPVX(sym);
goto intro_sym;
}
else {
- OP *o = newOP(OP_PADSV, 0);
+ OP * const o = newOP(OP_PADSV, 0);
o->op_targ = tmp;
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
/* If it's none of the above, it must be a literal filehandle
(<Foo::BAR> or <FOO>) so build a simple readline OP */
else {
- GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
+ GV * const gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
STATIC char *
S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
{
+ dVAR;
SV *sv; /* scalar value: string */
char *tmps; /* temp string, used for delimiter matching */
register char *s = start; /* current position in the buffer */
char *last = NULL; /* last position for nesting bracket */
/* skip space before the delimiter */
- if (isSPACE(*s))
- s = skipspace(s);
+ if (isSPACE(*s)) {
+ s = PEEKSPACE(s);
+ }
/* mark where we are, in case we need to report errors */
CLINE;
PL_multi_close = term;
- /* create a new SV to hold the contents. 87 is leak category, I'm
- assuming. 79 is the SV's initial length. What a random number. */
- sv = NEWSV(87,79);
+ /* create a new SV to hold the contents. 79 is the SV's initial length.
+ What a random number. */
+ sv = newSV(79);
sv_upgrade(sv, SVt_PVIV);
SvIV_set(sv, termcode);
(void)SvPOK_only(sv); /* validate pointer */
int offset = s - SvPVX_const(PL_linestr);
const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
&offset, (char*)termstr, termlen);
- const char *ns = SvPVX_const(PL_linestr) + offset;
- char *svlast = SvEND(sv) - 1;
+ const char * const ns = SvPVX_const(PL_linestr) + offset;
+ char * const svlast = SvEND(sv) - 1;
for (; s < ns; s++) {
if (*s == '\n' && !PL_rsfp)
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
sv_free(sv);
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
- return Nullch;
+ return NULL;
}
/* we read a line, so increment our line counter */
CopLINE_inc(PL_curcop);
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(88,0);
+ SV * const line_sv = newSV(0);
- sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,PL_linestr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
+ sv_upgrade(line_sv, SVt_PVMG);
+ sv_setsv(line_sv,PL_linestr);
+ (void)SvIOK_on(line_sv);
+ SvIV_set(line_sv, 0);
+ av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), line_sv);
}
/* having changed the buffer, we must update PL_bufend */
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
}
/* at this point, we have successfully read the delimited string */
char *
Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
{
+ dVAR;
register const char *s = start; /* current position in buffer */
register char *d; /* destination in temp buffer */
register char *e; /* end of temp buffer */
NV nv; /* number read, as a double */
- SV *sv = Nullsv; /* place to put the converted number */
+ SV *sv = NULL; /* place to put the converted number */
bool floatit; /* boolean: int or float? */
- const char *lastub = 0; /* position of last underbar */
+ const char *lastub = NULL; /* position of last underbar */
static char const number_too_long[] = "Number too long";
/* We use the first character to decide what type of number this is */
Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
- sv = NEWSV(92,0);
+ sv = newSV(0);
if (overflowed) {
if (n > 4294967295.0 && ckWARN(WARN_PORTABLE))
Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
}
if (just_zero && (PL_hints & HINT_NEW_INTEGER))
sv = new_constant(start, s - start, "integer",
- sv, Nullsv, NULL);
+ sv, NULL, NULL);
else if (PL_hints & HINT_NEW_BINARY)
- sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
+ sv = new_constant(start, s - start, "binary", sv, NULL, NULL);
}
break;
/* make an sv from the string */
- sv = NEWSV(92,0);
+ sv = newSV(0);
/*
We try to do an integer conversion first if no characters
if (!floatit) {
UV uv;
- int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
+ const int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
if (flags == IS_NUMBER_IN_UV) {
if (uv <= IV_MAX)
(PL_hints & HINT_NEW_INTEGER) )
sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
(floatit ? "float" : "integer"),
- sv, Nullsv, NULL);
+ sv, NULL, NULL);
break;
/* if it starts with a v, it could be a v-string */
case 'v':
vstring:
- sv = NEWSV(92,5); /* preallocate storage space */
+ sv = newSV(5); /* preallocate storage space */
s = scan_vstring(s,sv);
break;
}
if (sv)
lvalp->opval = newSVOP(OP_CONST, 0, sv);
else
- lvalp->opval = Nullop;
+ lvalp->opval = NULL;
return (char *)s;
}
STATIC char *
S_scan_formline(pTHX_ register char *s)
{
+ dVAR;
register char *eol;
register char *t;
- SV *stuff = newSVpvn("",0);
+ SV * const stuff = newSVpvs("");
bool needargs = FALSE;
bool eofmt = FALSE;
s = filter_gets(PL_linestr, PL_rsfp, 0);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend = PL_bufptr + SvCUR(PL_linestr);
- PL_last_lop = PL_last_uni = Nullch;
+ PL_last_lop = PL_last_uni = NULL;
if (!s) {
s = PL_bufptr;
break;
PL_expect = XTERM;
if (needargs) {
PL_lex_state = LEX_NORMAL;
- PL_nextval[PL_nexttoke].ival = 0;
+ NEXTVAL_NEXTTOKE.ival = 0;
force_next(',');
}
else
else if (PL_encoding)
sv_recode_to_utf8(stuff, PL_encoding);
}
- PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
+ NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, stuff);
force_next(THING);
- PL_nextval[PL_nexttoke].ival = OP_FORMLINE;
+ NEXTVAL_NEXTTOKE.ival = OP_FORMLINE;
force_next(LSTOP);
}
else {
S_set_csh(pTHX)
{
#ifdef CSH
+ dVAR;
if (!PL_cshlen)
PL_cshlen = strlen(PL_cshname);
+#else
+#if defined(USE_ITHREADS)
+ PERL_UNUSED_CONTEXT;
+#endif
#endif
}
I32
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
+ dVAR;
const I32 oldsavestack_ix = PL_savestack_ix;
- CV* outsidecv = PL_compcv;
+ CV* const outsidecv = PL_compcv;
if (PL_compcv) {
assert(SvTYPE(PL_compcv) == SVt_PVCV);
save_item(PL_subname);
SAVESPTR(PL_compcv);
- PL_compcv = (CV*)NEWSV(1104,0);
+ PL_compcv = (CV*)newSV(0);
sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
CvFLAGS(PL_compcv) |= flags;
PL_subline = CopLINE(PL_curcop);
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
- CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
+ CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outsidecv);
CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
return oldsavestack_ix;
int
Perl_yywarn(pTHX_ const char *s)
{
+ dVAR;
PL_in_eval |= EVAL_WARNONLY;
yyerror(s);
PL_in_eval &= ~EVAL_WARNONLY;
int
Perl_yyerror(pTHX_ const char *s)
{
+ dVAR;
const char *where = NULL;
const char *context = NULL;
int contlen = -1;
where = "within string";
}
else {
- SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
+ SV * const where_sv = sv_2mortal(newSVpvs("next char "));
if (yychar < 32)
Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
else if (isPRINT_LC(yychar))
OutCopFILE(PL_curcop));
}
PL_in_my = 0;
- PL_in_my_stash = Nullhv;
+ PL_in_my_stash = NULL;
return 0;
}
#ifdef __SC__
STATIC char*
S_swallow_bom(pTHX_ U8 *s)
{
+ dVAR;
const STRLEN slen = SvCUR(PL_linestr);
switch (s[0]) {
case 0xFF:
static void
restore_rsfp(pTHX_ void *f)
{
- PerlIO *fp = (PerlIO*)f;
+ dVAR;
+ PerlIO * const fp = (PerlIO*)f;
if (PL_rsfp == PerlIO_stdin())
PerlIO_clearerr(PL_rsfp);
static I32
utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ dVAR;
const STRLEN old = SvCUR(sv);
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
static I32
utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ dVAR;
const STRLEN old = SvCUR(sv);
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
Function must be called like
- sv = NEWSV(92,5);
+ sv = newSV(5);
s = scan_vstring(s,sv);
The sv should already be large enough to store the vstring
char *
Perl_scan_vstring(pTHX_ const char *s, SV *sv)
{
+ dVAR;
const char *pos = s;
const char *start = s;
if (*pos == 'v') pos++; /* get past 'v' */
}
if (!isALPHA(*pos)) {
- UV rev;
U8 tmpbuf[UTF8_MAXBYTES+1];
- U8 *tmpend;
if (*s == 'v') s++; /* get past 'v' */
sv_setpvn(sv, "", 0);
for (;;) {
- rev = 0;
+ U8 *tmpend;
+ UV rev = 0;
{
/* this is atoi() that tolerates underscores */
const char *end = pos;
https://perl5.git.perl.org / perl5.git / blobdiff