#define LEX_INTERPCONST 2 /* NOT USED */
#define LEX_FORMLINE 1 /* expecting a format line */
+/* returned to yyl_try() to request it to retry the parse loop, expected to only
+ be returned directly by yyl_fake_eof(), but functions that call yyl_fake_eof()
+ can also return it.
+
+ yylex (aka Perl_yylex) returns 0 on EOF rather than returning -1,
+ other token values are 258 or higher (see perly.h), so -1 should be
+ a safe value here.
+*/
+#define YYL_RETRY (-1)
#ifdef DEBUGGING
static const char* const lex_state_names[] = {
* Aop : addition-level operator
* AopNOASSIGN : addition-level operator that is never part of .=
* Mop : multiplication-level operator
- * Eop : equality-testing operator
- * Rop : relational operator <= != gt
+ * ChEop : chaining equality-testing operator
+ * NCEop : non-chaining comparison operator at equality precedence
+ * ChRop : chaining relational operator <= != gt
+ * NCRop : non-chaining relational operator isa
*
* Also see LOP and lop() below.
*/
#define Aop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)ADDOP))
#define AopNOASSIGN(f) return (pl_yylval.ival=f, PL_bufptr=s, REPORT((int)ADDOP))
#define Mop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)MULOP))
-#define Eop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
-#define Rop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
+#define ChEop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)CHEQOP))
+#define NCEop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)NCEQOP))
+#define ChRop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)CHRELOP))
+#define NCRop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)NCRELOP))
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
static const struct code no_code = { NULL, NULL, NULL, NULL, NULL, 0, FALSE };
-
#ifdef DEBUGGING
/* how to interpret the pl_yylval associated with the token */
{ ASSIGNOP, TOKENTYPE_OPNUM, "ASSIGNOP" },
{ BITANDOP, TOKENTYPE_OPNUM, "BITANDOP" },
{ BITOROP, TOKENTYPE_OPNUM, "BITOROP" },
+ { CHEQOP, TOKENTYPE_OPNUM, "CHEQOP" },
+ { CHRELOP, TOKENTYPE_OPNUM, "CHRELOP" },
{ COLONATTR, TOKENTYPE_NONE, "COLONATTR" },
{ CONTINUE, TOKENTYPE_NONE, "CONTINUE" },
{ DEFAULT, TOKENTYPE_NONE, "DEFAULT" },
{ DOTDOT, TOKENTYPE_IVAL, "DOTDOT" },
{ ELSE, TOKENTYPE_NONE, "ELSE" },
{ ELSIF, TOKENTYPE_IVAL, "ELSIF" },
- { EQOP, TOKENTYPE_OPNUM, "EQOP" },
{ FOR, TOKENTYPE_IVAL, "FOR" },
{ FORMAT, TOKENTYPE_NONE, "FORMAT" },
{ FORMLBRACK, TOKENTYPE_NONE, "FORMLBRACK" },
{ METHOD, TOKENTYPE_OPVAL, "METHOD" },
{ MULOP, TOKENTYPE_OPNUM, "MULOP" },
{ MY, TOKENTYPE_IVAL, "MY" },
+ { NCEQOP, TOKENTYPE_OPNUM, "NCEQOP" },
+ { NCRELOP, TOKENTYPE_OPNUM, "NCRELOP" },
{ NOAMP, TOKENTYPE_NONE, "NOAMP" },
{ NOTOP, TOKENTYPE_NONE, "NOTOP" },
{ OROP, TOKENTYPE_IVAL, "OROP" },
{ PRIVATEREF, TOKENTYPE_OPVAL, "PRIVATEREF" },
{ QWLIST, TOKENTYPE_OPVAL, "QWLIST" },
{ REFGEN, TOKENTYPE_NONE, "REFGEN" },
- { RELOP, TOKENTYPE_OPNUM, "RELOP" },
{ REQUIRE, TOKENTYPE_NONE, "REQUIRE" },
{ SHIFTOP, TOKENTYPE_OPNUM, "SHIFTOP" },
{ SIGSUB, TOKENTYPE_NONE, "SIGSUB" },
void
Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
{
- dVAR;
char *bufptr;
PERL_ARGS_ASSERT_LEX_STUFF_PVN;
if (flags & ~(LEX_STUFF_UTF8))
I32
Perl_lex_peek_unichar(pTHX_ U32 flags)
{
- dVAR;
char *s, *bufend;
if (flags & ~(LEX_KEEP_PREVIOUS))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_peek_unichar");
const char* context = s - 3;
STRLEN context_len = e - context + 1; /* include all of \N{...} */
- dVAR;
PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME;
} else if (PL_lex_inpat && SvIVX(PL_linestr) == '\'') {
type = "q";
typelen = 1;
- } else {
+ } else {
type = "qq";
typelen = 2;
}
TOKEN(0);
}
- Eop(OP_NE);
+ ChEop(OP_NE);
}
if (tmp == '~')
Perl_ck_warner_d(aTHX_
packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
"Smartmatch is experimental");
- Eop(OP_SMARTMATCH);
+ NCEop(OP_SMARTMATCH);
}
s++;
if ((bof = FEATURE_BITWISE_IS_ENABLED) && *s == '.') {
s -= 3;
TOKEN(0);
}
- Eop(OP_NCMP);
+ NCEop(OP_NCMP);
}
s--;
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 2;
TOKEN(0);
}
- Rop(OP_LE);
+ ChRop(OP_LE);
}
s--;
TOKEN(0);
}
- Rop(OP_LT);
+ ChRop(OP_LT);
}
static int
s -= 2;
TOKEN(0);
}
- Rop(OP_GE);
+ ChRop(OP_GE);
}
s--;
TOKEN(0);
}
- Rop(OP_GT);
+ ChRop(OP_GT);
}
static int
}
static int
-yyl_dblquote(pTHX_ char *s, STRLEN len)
+yyl_dblquote(pTHX_ char *s)
{
char *d;
+ STRLEN len;
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
DEBUG_T( {
if (s)
OPERATOR(MY);
}
-static int yyl_try(pTHX_ char*, STRLEN);
+static int yyl_try(pTHX_ char*);
static bool
yyl_eol_needs_semicolon(pTHX_ char **ps)
}
static int
-yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
+yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
{
char *d;
&& !instr(s,"indir")
&& instr(PL_origargv[0],"perl"))
{
- dVAR;
char **newargv;
*ipathend = '\0';
we must not do it again */
{
SvPVCLEAR(PL_linestr);
- PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufptr = PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
PL_preambled = FALSE;
if (PERLDB_LINE_OR_SAVESRC)
(void)gv_fetchfile(PL_origfilename);
- return yyl_try(aTHX_ s, len);
+ return YYL_RETRY;
}
}
}
TOKEN(';');
}
- return yyl_try(aTHX_ s, len);
+ PL_bufptr = s;
+ return YYL_RETRY;
}
static int
case KEY___END__:
if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D'))
yyl_data_handle(aTHX);
- return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len);
+ return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s);
case KEY___SUB__:
FUN0OP(CvCLONE(PL_compcv)
case KEY_cmp:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Eop(OP_SCMP);
+ NCEop(OP_SCMP);
case KEY_caller:
UNI(OP_CALLER);
case KEY_crypt:
-#ifdef FCRYPT
- if (!PL_cryptseen) {
- PL_cryptseen = TRUE;
- init_des();
- }
-#endif
+
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
case KEY_eq:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Eop(OP_SEQ);
+ ChEop(OP_SEQ);
case KEY_exists:
UNI(OP_EXISTS);
case KEY_gt:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Rop(OP_SGT);
+ ChRop(OP_SGT);
case KEY_ge:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Rop(OP_SGE);
+ ChRop(OP_SGE);
case KEY_grep:
LOP(OP_GREPSTART, XREF);
case KEY_isa:
Perl_ck_warner_d(aTHX_
packWARN(WARN_EXPERIMENTAL__ISA), "isa is experimental");
- Rop(OP_ISA);
+ NCRop(OP_ISA);
case KEY_join:
LOP(OP_JOIN,XTERM);
case KEY_lt:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Rop(OP_SLT);
+ ChRop(OP_SLT);
case KEY_le:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Rop(OP_SLE);
+ ChRop(OP_SLE);
case KEY_localtime:
UNI(OP_LOCALTIME);
case KEY_ne:
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
return REPORT(0);
- Eop(OP_SNE);
+ ChEop(OP_SNE);
case KEY_no:
s = tokenize_use(0, s);
static int
yyl_keylookup(pTHX_ char *s, GV *gv)
{
- dVAR;
STRLEN len;
bool anydelim;
I32 key;
}
static int
-yyl_try(pTHX_ char *s, STRLEN len)
+yyl_try(pTHX_ char *s)
{
char *d;
GV *gv = NULL;
+ int tok;
retry:
switch (*s) {
default:
- if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s))
- return yyl_keylookup(aTHX_ s, gv);
+ if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s)) {
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
+ }
yyl_croak_unrecognised(aTHX_ s);
case 4:
case 26:
/* emulate EOF on ^D or ^Z */
- return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len);
+ if ((tok = yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s)) != YYL_RETRY)
+ return tok;
+ retry_bufptr:
+ s = PL_bufptr;
+ goto retry;
case 0:
if ((!PL_rsfp || PL_lex_inwhat)
}
if (PL_minus_E)
sv_catpvs(PL_linestr,
- "use feature ':5." STRINGIFY(PERL_VERSION) "';");
+ "use feature ':" STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION) "';");
if (PL_minus_n || PL_minus_p) {
sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
if (PL_minus_l)
update_debugger_info(PL_linestr, NULL, 0);
goto retry;
}
- return yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s, len);
+ if ((tok = yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
case '\r':
#ifdef PERL_STRICT_CR
case '=':
if (s[1] == '=' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), "====="))
+ && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), "====="))
{
s = vcs_conflict_marker(s + 7);
goto retry;
s -= 2;
TOKEN(0);
}
- Eop(OP_EQ);
+ ChEop(OP_EQ);
}
if (tmp == '>') {
if (!PL_lex_allbrackets
case '<':
if (s[1] == '<' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s+2, (STRLEN) (PL_bufend - (s+2)), "<<<<<"))
+ && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), "<<<<<"))
{
s = vcs_conflict_marker(s + 7);
goto retry;
case '>':
if (s[1] == '>' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), ">>>>>"))
+ && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), ">>>>>"))
{
s = vcs_conflict_marker(s + 7);
goto retry;
return yyl_sglquote(aTHX_ s);
case '"':
- return yyl_dblquote(aTHX_ s, len);
+ return yyl_dblquote(aTHX_ s);
case '`':
return yyl_backtick(aTHX_ s);
TERM(THING);
}
else if ((*start == ':' && start[1] == ':')
- || (PL_expect == XSTATE && *start == ':'))
- return yyl_keylookup(aTHX_ s, gv);
+ || (PL_expect == XSTATE && *start == ':')) {
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
+ }
else if (PL_expect == XSTATE) {
d = start;
while (d < PL_bufend && isSPACE(*d)) d++;
- if (*d == ':')
- return yyl_keylookup(aTHX_ s, gv);
+ if (*d == ':') {
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
+ }
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
if (!isALPHA(*start) && (PL_expect == XTERM
}
}
}
- return yyl_keylookup(aTHX_ s, gv);
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
case 'x':
if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
s++;
Mop(OP_REPEAT);
}
- return yyl_keylookup(aTHX_ s, gv);
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
case '_':
case 'a': case 'A':
case 'X':
case 'y': case 'Y':
case 'z': case 'Z':
- return yyl_keylookup(aTHX_ s, gv);
+ if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+ return tok;
+ goto retry_bufptr;
}
}
int
Perl_yylex(pTHX)
{
- dVAR;
char *s = PL_bufptr;
if (UNLIKELY(PL_parser->recheck_utf8_validity)) {
expecting an operator) have been a sigil.
*/
bool expected_operator = (PL_expect == XOPERATOR);
- int ret = yyl_try(aTHX_ s, 0);
+ int ret = yyl_try(aTHX_ s);
switch (pl_yylval.ival) {
case OP_BIT_AND:
case OP_MODULO:
/* if we allocated too much space, give some back */
if (SvCUR(sv) + 5 < SvLEN(sv)) {
SvLEN_set(sv, SvCUR(sv) + 1);
- SvPV_renew(sv, SvLEN(sv));
+ SvPV_shrink_to_cur(sv);
}
/* decide whether this is the first or second quoted string we've read
Perl_wrap_keyword_plugin(pTHX_
Perl_keyword_plugin_t new_plugin, Perl_keyword_plugin_t *old_plugin_p)
{
- dVAR;
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_WRAP_KEYWORD_PLUGIN;
https://perl5.git.perl.org / perl5.git / blobdiff