} STMT_END
+/* A file-local structure for passing around information about subroutines and
+ * related definable words */
+struct code {
+ SV *sv;
+ CV *cv;
+ GV *gv, **gvp;
+ OP *rv2cv_op;
+ PADOFFSET off;
+ bool lex;
+};
+
+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 */
}
else {
/* Similarly for utf8. For invariants can check directly; for other
- * Latin1, can calculate their code point and check; otherwise use a
- * swash */
+ * Latin1, can calculate their code point and check; otherwise use an
+ * inversion list */
if (UTF8_IS_INVARIANT(*s)) {
if (! isALPHAU(*s)) {
goto bad_charname;
bool dorange = FALSE; /* are we in a translit range? */
bool didrange = FALSE; /* did we just finish a range? */
bool in_charclass = FALSE; /* within /[...]/ */
- bool d_is_utf8 = FALSE; /* Output constant is UTF8 */
bool s_is_utf8 = cBOOL(UTF); /* Is the source string assumed to be
UTF8? But, this can show as true
when the source isn't utf8, as for
example when it is entirely composed
of hex constants */
+ bool d_is_utf8 = FALSE; /* Output constant is UTF8 */
STRLEN utf8_variant_count = 0; /* When not in UTF-8, this counts the
number of characters found so far
that will expand (into 2 bytes)
PERL_ARGS_ASSERT_SCAN_CONST;
assert(PL_lex_inwhat != OP_TRANSR);
- if (PL_lex_inwhat == OP_TRANS && PL_parser->lex_sub_op) {
- /* If we are doing a trans and we know we want UTF8 set expectation */
- d_is_utf8 = PL_parser->lex_sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
- s_is_utf8 = PL_parser->lex_sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
- }
/* Protect sv from errors and fatal warnings. */
ENTER_with_name("scan_const");
* order to make the transliteration a simple table look-up.
* Ranges that extend above Latin1 have to be done differently, so
* there is no advantage to expanding them here, so they are
- * stored here as Min, ILLEGAL_UTF8_BYTE, Max. The illegal byte
- * signifies a hyphen without any possible ambiguity. On EBCDIC
- * machines, if the range is expressed as Unicode, the Latin1
- * portion is expanded out even if the range extends above
- * Latin1. This is because each code point in it has to be
- * processed here individually to get its native translation */
+ * stored here as Min, RANGE_INDICATOR, Max. 'RANGE_INDICATOR' is
+ * a byte that can't occur in legal UTF-8, and hence can signify a
+ * hyphen without any possible ambiguity. On EBCDIC machines, if
+ * the range is expressed as Unicode, the Latin1 portion is
+ * expanded out even if the range extends above Latin1. This is
+ * because each code point in it has to be processed here
+ * individually to get its native translation */
if (! dorange) {
* is not a hyphen; or if it is a hyphen, but it's too close to
* either edge to indicate a range, or if we haven't output any
* characters yet then it's a regular character. */
- if (*s != '-' || s >= send - 1 || s == start || d == SvPVX(sv)) {
+ if (*s != '-' || s >= send - 1 || s == start || d == SvPVX(sv))
+ {
/* A regular character. Process like any other, but first
* clear any flags */
s++; /* Skip past the hyphen */
/* d now points to where the end-range character will be
- * placed. Save it so won't have to go finding it later,
- * and drop down to get that character. (Actually we
- * instead save the offset, to handle the case where a
- * realloc in the meantime could change the actual
- * pointer). We'll finish processing the range the next
- * time through the loop */
- offset_to_max = d - SvPVX_const(sv);
+ * placed. Drop down to get that character. We'll finish
+ * processing the range the next time through the loop */
if (s_is_utf8 && UTF8_IS_ABOVE_LATIN1(*s)) {
has_above_latin1 = TRUE;
* are the range start and range end, in order.
* 'd' points to just beyond the range end in the 'sv' string,
* where we would next place something
- * 'offset_to_max' is the offset in 'sv' at which the character
- * (the range's maximum end point) before 'd' begins.
*/
char * max_ptr;
char * min_ptr;
while (e-- > max_ptr) {
*(e + 1) = *e;
}
- *(e + 1) = (char) ILLEGAL_UTF8_BYTE;
+ *(e + 1) = (char) RANGE_INDICATOR;
goto range_done;
}
*d++ = (char) UTF8_TWO_BYTE_LO(0x100);
if (real_range_max > 0x100) {
if (real_range_max > 0x101) {
- *d++ = (char) ILLEGAL_UTF8_BYTE;
+ *d++ = (char) RANGE_INDICATOR;
}
d = (char*)uvchr_to_utf8((U8*)d, real_range_max);
}
}
d = (char*)uvchr_to_utf8((U8*)d, uv);
- if (PL_lex_inwhat == OP_TRANS
- && PL_parser->lex_sub_op)
- {
- PL_parser->lex_sub_op->op_private |=
- (PL_lex_repl ? OPpTRANS_FROM_UTF
- : OPpTRANS_TO_UTF);
- }
}
}
#ifdef EBCDIC
SvPOK_on(sv);
if (d_is_utf8) {
SvUTF8_on(sv);
- if (PL_lex_inwhat == OP_TRANS && PL_parser->lex_sub_op) {
- PL_parser->lex_sub_op->op_private |=
- (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
- }
}
/* shrink the sv if we allocated more than we used */
TOKEN(0);
}
- PL_parser->saw_infix_sigil = 1;
Mop(OP_MULTIPLY);
}
TOKEN(0);
}
++s;
- PL_parser->saw_infix_sigil = 1;
Mop(OP_MODULO);
}
else if (PL_expect == XPOSTDEREF)
}
static int
-yyl_leftcurly(pTHX_ char *s, U8 formbrack)
+yyl_leftcurly(pTHX_ char *s, const U8 formbrack)
{
char *d;
if (PL_lex_brackets > 100) {
}
static int
-yyl_rightcurly(pTHX_ char *s, U8 formbrack)
+yyl_rightcurly(pTHX_ char *s, const U8 formbrack)
{
+ assert(s != PL_bufend);
+ s++;
+
if (PL_lex_brackets <= 0)
/* diag_listed_as: Unmatched right %s bracket */
yyerror("Unmatched right curly bracket");
s--;
TOKEN(0);
}
- if (d == s) {
- PL_parser->saw_infix_sigil = 1;
+ if (d == s)
BAop(bof ? OP_NBIT_AND : OP_BIT_AND);
- }
else
BAop(OP_SBIT_AND);
}
}
static int
-yyl_my(pTHX_ char **sp, I32 my)
+yyl_my(pTHX_ char *s, I32 my)
{
- char *s = *sp;
if (PL_in_my) {
PL_bufptr = s;
yyerror(Perl_form(aTHX_
if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) {
STRLEN len;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
- if (memEQs(PL_tokenbuf, len, "sub")) {
- *sp = s;
- return SUB;
- }
+ if (memEQs(PL_tokenbuf, len, "sub"))
+ return yyl_sub(aTHX_ s, my);
PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
if (!PL_in_my_stash) {
char tmpbuf[1024];
OPERATOR(MY);
}
-static int yyl_try(pTHX_ char, char*, STRLEN, I32, GV*, GV**, U8, U32, const bool);
+static int yyl_try(pTHX_ char*, STRLEN);
-#define RETRY() yyl_try(aTHX_ 0, s, len, orig_keyword, gv, gvp, \
- formbrack, fake_eof, saw_infix_sigil)
-
-static int
-yyl_eol(pTHX_ char *s, STRLEN len,
- I32 orig_keyword, GV *gv, GV **gvp,
- U8 formbrack, U32 fake_eof, const bool saw_infix_sigil)
+static bool
+yyl_eol_needs_semicolon(pTHX_ char **ps)
{
+ char *s = *ps;
if (PL_lex_state != LEX_NORMAL
|| (PL_in_eval && !PL_rsfp && !PL_parser->filtered))
{
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_lex_state = LEX_FORMLINE;
force_next(FORMRBRACK);
- TOKEN(';');
+ *ps = s;
+ return TRUE;
}
}
else {
incline(s, PL_bufend);
}
}
- return RETRY();
+ *ps = s;
+ return FALSE;
}
static int
-yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len,
- I32 orig_keyword, GV *gv, GV **gvp,
- U8 formbrack, const bool saw_infix_sigil)
+yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
{
char *d;
PL_preambled = FALSE;
if (PERLDB_LINE_OR_SAVESRC)
(void)gv_fetchfile(PL_origfilename);
- return RETRY();
+ return yyl_try(aTHX_ s, len);
}
}
}
TOKEN(';');
}
- return RETRY();
+ return yyl_try(aTHX_ s, len);
}
static int
}
static int
-yyl_safe_bareword(pTHX_ char *s, const char lastchar, const bool saw_infix_sigil)
+yyl_safe_bareword(pTHX_ char *s, const char lastchar)
{
if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
- && saw_infix_sigil)
+ && PL_parser->saw_infix_sigil)
{
Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
"Operator or semicolon missing before %c%" UTF8f,
}
static int
-yyl_try(pTHX_ char initial_state, char *s, STRLEN len,
- I32 orig_keyword, GV *gv, GV **gvp,
- U8 formbrack, U32 fake_eof, const bool saw_infix_sigil)
+yyl_constant_op(pTHX_ char *s, SV *sv, CV *cv, OP *rv2cv_op, PADOFFSET off)
+{
+ if (sv) {
+ op_free(rv2cv_op);
+ SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
+ ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
+ if (SvTYPE(sv) == SVt_PVAV)
+ pl_yylval.opval = newUNOP(OP_RV2AV, OPf_PARENS,
+ pl_yylval.opval);
+ else {
+ pl_yylval.opval->op_private = 0;
+ pl_yylval.opval->op_folded = 1;
+ pl_yylval.opval->op_flags |= OPf_SPECIAL;
+ }
+ TOKEN(BAREWORD);
+ }
+
+ op_free(pl_yylval.opval);
+ pl_yylval.opval =
+ off ? newCVREF(0, rv2cv_op) : rv2cv_op;
+ pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = OP_ENTERSUB;
+
+ /* Is there a prototype? */
+ if (SvPOK(cv)) {
+ int k = yyl_subproto(aTHX_ s, cv);
+ if (k != KEY_NULL)
+ return k;
+ }
+
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
+ PL_expect = XTERM;
+ force_next(off ? PRIVATEREF : BAREWORD);
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
+ PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
+
+ TOKEN(NOAMP);
+}
+
+/* Honour "reserved word" warnings, and enforce strict subs */
+static void
+yyl_strictwarn_bareword(pTHX_ const char lastchar)
+{
+ /* after "print" and similar functions (corresponding to
+ * "F? L" in opcode.pl), whatever wasn't already parsed as
+ * a filehandle should be subject to "strict subs".
+ * Likewise for the optional indirect-object argument to system
+ * or exec, which can't be a bareword */
+ if ((PL_last_lop_op == OP_PRINT
+ || PL_last_lop_op == OP_PRTF
+ || PL_last_lop_op == OP_SAY
+ || PL_last_lop_op == OP_SYSTEM
+ || PL_last_lop_op == OP_EXEC)
+ && (PL_hints & HINT_STRICT_SUBS))
+ {
+ pl_yylval.opval->op_private |= OPpCONST_STRICT;
+ }
+
+ if (lastchar != '-' && ckWARN(WARN_RESERVED)) {
+ char *d = PL_tokenbuf;
+ while (isLOWER(*d))
+ d++;
+ if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0)) {
+ /* PL_warn_reserved is constant */
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
+ Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
+ PL_tokenbuf);
+ GCC_DIAG_RESTORE_STMT;
+ }
+ }
+}
+
+static int
+yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c)
{
- char *d;
- bool bof = FALSE;
+ int pkgname = 0;
+ const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
+ bool safebw;
+ bool no_op_error = FALSE;
+ /* Use this var to track whether intuit_method has been
+ called. intuit_method returns 0 or > 255. */
+ int key = 1;
- switch (initial_state) {
- case '}': goto rightbracket;
+ if (PL_expect == XOPERATOR) {
+ if (PL_bufptr == PL_linestart) {
+ CopLINE_dec(PL_curcop);
+ Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
+ CopLINE_inc(PL_curcop);
+ }
+ else
+ /* We want to call no_op with s pointing after the
+ bareword, so defer it. But we want it to come
+ before the Bad name croak. */
+ no_op_error = TRUE;
+ }
+
+ /* Get the rest if it looks like a package qualifier */
+
+ if (*s == '\'' || (*s == ':' && s[1] == ':')) {
+ STRLEN morelen;
+ s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
+ TRUE, &morelen);
+ if (no_op_error) {
+ no_op("Bareword",s);
+ no_op_error = FALSE;
+ }
+ if (!morelen)
+ Perl_croak(aTHX_ "Bad name after %" UTF8f "%s",
+ UTF8fARG(UTF, len, PL_tokenbuf),
+ *s == '\'' ? "'" : "::");
+ len += morelen;
+ pkgname = 1;
+ }
+
+ if (no_op_error)
+ no_op("Bareword",s);
+
+ /* See if the name is "Foo::",
+ in which case Foo is a bareword
+ (and a package name). */
+
+ if (len > 2 && PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':') {
+ if (ckWARN(WARN_BAREWORD)
+ && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
+ Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
+ "Bareword \"%" UTF8f
+ "\" refers to nonexistent package",
+ UTF8fARG(UTF, len, PL_tokenbuf));
+ len -= 2;
+ PL_tokenbuf[len] = '\0';
+ c.gv = NULL;
+ c.gvp = 0;
+ safebw = TRUE;
+ }
+ else {
+ safebw = FALSE;
}
- switch (*s) {
- default:
- if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s))
- goto keylookup;
- yyl_croak_unrecognised(aTHX_ s);
+ /* if we saw a global override before, get the right name */
- case 4:
- case 26:
- /* emulate EOF on ^D or ^Z */
- return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len,
- orig_keyword, gv, gvp, formbrack, saw_infix_sigil);
+ if (!c.sv)
+ c.sv = S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len);
+ if (c.gvp) {
+ SV *sv = newSVpvs("CORE::GLOBAL::");
+ sv_catsv(sv, c.sv);
+ SvREFCNT_dec(c.sv);
+ c.sv = sv;
+ }
- case 0:
- if ((!PL_rsfp || PL_lex_inwhat)
- && (!PL_parser->filtered || s+1 < PL_bufend)) {
- PL_last_uni = 0;
- PL_last_lop = 0;
- if (PL_lex_brackets
- && PL_lex_brackstack[PL_lex_brackets-1] != XFAKEEOF)
- {
- yyerror((const char *)
- (PL_lex_formbrack
- ? "Format not terminated"
- : "Missing right curly or square bracket"));
- }
- DEBUG_T({
- PerlIO_printf(Perl_debug_log, "### Tokener got EOF\n");
- });
- TOKEN(0);
- }
- if (s++ < PL_bufend)
- return RETRY(); /* ignore stray nulls */
- PL_last_uni = 0;
- PL_last_lop = 0;
- if (!PL_in_eval && !PL_preambled) {
- PL_preambled = TRUE;
- if (PL_perldb) {
- /* Generate a string of Perl code to load the debugger.
- * If PERL5DB is set, it will return the contents of that,
- * otherwise a compile-time require of perl5db.pl. */
+ /* Presume this is going to be a bareword of some sort. */
+ CLINE;
+ pl_yylval.opval = newSVOP(OP_CONST, 0, c.sv);
+ pl_yylval.opval->op_private = OPpCONST_BARE;
- const char * const pdb = PerlEnv_getenv("PERL5DB");
+ /* And if "Foo::", then that's what it certainly is. */
+ if (safebw)
+ return yyl_safe_bareword(aTHX_ s, lastchar);
+
+ if (!c.off) {
+ OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(c.sv));
+ const_op->op_private = OPpCONST_BARE;
+ c.rv2cv_op = newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op);
+ c.cv = c.lex
+ ? isGV(c.gv)
+ ? GvCV(c.gv)
+ : SvROK(c.gv) && SvTYPE(SvRV(c.gv)) == SVt_PVCV
+ ? (CV *)SvRV(c.gv)
+ : ((CV *)c.gv)
+ : rv2cv_op_cv(c.rv2cv_op, RV2CVOPCV_RETURN_STUB);
+ }
+
+ /* See if it's the indirect object for a list operator. */
+
+ if (PL_oldoldbufptr
+ && PL_oldoldbufptr < PL_bufptr
+ && (PL_oldoldbufptr == PL_last_lop
+ || PL_oldoldbufptr == PL_last_uni)
+ && /* NO SKIPSPACE BEFORE HERE! */
+ (PL_expect == XREF
+ || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7)
+ == OA_FILEREF))
+ {
+ bool immediate_paren = *s == '(';
+ SSize_t s_off;
- if (pdb) {
- sv_setpv(PL_linestr, pdb);
- sv_catpvs(PL_linestr,";");
- } else {
- SETERRNO(0,SS_NORMAL);
- sv_setpvs(PL_linestr, "BEGIN { require 'perl5db.pl' };");
- }
- PL_parser->preambling = CopLINE(PL_curcop);
- } else
- SvPVCLEAR(PL_linestr);
- if (PL_preambleav) {
- SV **svp = AvARRAY(PL_preambleav);
- SV **const end = svp + AvFILLp(PL_preambleav);
- while(svp <= end) {
- sv_catsv(PL_linestr, *svp);
- ++svp;
- sv_catpvs(PL_linestr, ";");
- }
- sv_free(MUTABLE_SV(PL_preambleav));
- PL_preambleav = NULL;
- }
- if (PL_minus_E)
- sv_catpvs(PL_linestr,
- "use feature ':5." STRINGIFY(PERL_VERSION) "';");
- if (PL_minus_n || PL_minus_p) {
- sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
- if (PL_minus_l)
- sv_catpvs(PL_linestr,"chomp;");
- if (PL_minus_a) {
- if (PL_minus_F) {
- if ( ( *PL_splitstr == '/'
- || *PL_splitstr == '\''
- || *PL_splitstr == '"')
- && strchr(PL_splitstr + 1, *PL_splitstr))
- {
- /* strchr is ok, because -F pattern can't contain
- * embeddded NULs */
- Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s);", PL_splitstr);
- }
- else {
- /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
- bytes can be used as quoting characters. :-) */
- const char *splits = PL_splitstr;
- sv_catpvs(PL_linestr, "our @F=split(q\0");
- do {
- /* Need to \ \s */
- if (*splits == '\\')
- sv_catpvn(PL_linestr, splits, 1);
- sv_catpvn(PL_linestr, splits, 1);
- } while (*splits++);
- /* This loop will embed the trailing NUL of
- PL_linestr as the last thing it does before
- terminating. */
- sv_catpvs(PL_linestr, ");");
- }
- }
- else
- sv_catpvs(PL_linestr,"our @F=split(' ');");
- }
- }
- 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 = NULL;
- if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash)
- update_debugger_info(PL_linestr, NULL, 0);
- return RETRY();
- }
- return yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s, len,
- orig_keyword, gv, gvp, formbrack, saw_infix_sigil);
+ /* (Now we can afford to cross potential line boundary.) */
+ s = skipspace(s);
- case '\r':
-#ifdef PERL_STRICT_CR
- Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
- Perl_croak(aTHX_
- "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
-#endif
- case ' ': case '\t': case '\f': case '\v':
- s++;
- return RETRY();
+ /* intuit_method() can indirectly call lex_next_chunk(),
+ * invalidating s
+ */
+ s_off = s - SvPVX(PL_linestr);
+ /* Two barewords in a row may indicate method call. */
+ if ( ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)
+ || *s == '$')
+ && (key = intuit_method(s, c.lex ? NULL : c.sv, c.cv)))
+ {
+ /* the code at method: doesn't use s */
+ goto method;
+ }
+ s = SvPVX(PL_linestr) + s_off;
- case '#':
- case '\n':
- return yyl_eol(aTHX_ s, len, orig_keyword, gv, gvp,
- formbrack, fake_eof, saw_infix_sigil);
+ /* 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
+ || (!c.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;
+ yyl_strictwarn_bareword(aTHX_ lastchar);
+ op_free(c.rv2cv_op);
+ return yyl_safe_bareword(aTHX_ s, lastchar);
+ }
+ }
- case '-':
- return yyl_hyphen(aTHX_ s);
+ PL_expect = XOPERATOR;
+ s = skipspace(s);
- case '+':
- return yyl_plus(aTHX_ s);
+ /* Is this a word before a => operator? */
+ if (*s == '=' && s[1] == '>' && !pkgname) {
+ op_free(c.rv2cv_op);
+ CLINE;
+ if (c.gvp || (c.lex && !c.off)) {
+ assert (cSVOPx(pl_yylval.opval)->op_sv == c.sv);
+ /* This is our own scalar, created a few lines
+ above, so this is safe. */
+ SvREADONLY_off(c.sv);
+ sv_setpv(c.sv, PL_tokenbuf);
+ if (UTF && !IN_BYTES
+ && is_utf8_string((U8*)PL_tokenbuf, len))
+ SvUTF8_on(c.sv);
+ SvREADONLY_on(c.sv);
+ }
+ TERM(BAREWORD);
+ }
+
+ /* If followed by a paren, it's certainly a subroutine. */
+ if (*s == '(') {
+ CLINE;
+ if (c.cv) {
+ char *d = s + 1;
+ while (SPACE_OR_TAB(*d))
+ d++;
+ if (*d == ')' && (c.sv = cv_const_sv_or_av(c.cv)))
+ return yyl_constant_op(aTHX_ d + 1, c.sv, c.cv, c.rv2cv_op, c.off);
+ }
+ NEXTVAL_NEXTTOKE.opval =
+ c.off ? c.rv2cv_op : pl_yylval.opval;
+ if (c.off)
+ op_free(pl_yylval.opval), force_next(PRIVATEREF);
+ else op_free(c.rv2cv_op), force_next(BAREWORD);
+ pl_yylval.ival = 0;
+ TOKEN('&');
+ }
- case '*':
- return yyl_star(aTHX_ s);
+ /* If followed by var or block, call it a method (unless sub) */
- case '%':
- return yyl_percent(aTHX_ s);
+ if ((*s == '$' || *s == '{') && !c.cv) {
+ op_free(c.rv2cv_op);
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = OP_METHOD;
+ if (!PL_lex_allbrackets && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ PL_expect = XBLOCKTERM;
+ PL_bufptr = s;
+ return REPORT(METHOD);
+ }
- case '^':
- return yyl_caret(aTHX_ s);
+ /* If followed by a bareword, see if it looks like indir obj. */
- case '[':
- return yyl_leftsquare(aTHX_ s);
+ if ( key == 1
+ && !orig_keyword
+ && (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || *s == '$')
+ && (key = intuit_method(s, c.lex ? NULL : c.sv, c.cv)))
+ {
+ method:
+ if (c.lex && !c.off) {
+ assert(cSVOPx(pl_yylval.opval)->op_sv == c.sv);
+ SvREADONLY_off(c.sv);
+ sv_setpvn(c.sv, PL_tokenbuf, len);
+ if (UTF && !IN_BYTES
+ && is_utf8_string((U8*)PL_tokenbuf, len))
+ SvUTF8_on(c.sv);
+ else SvUTF8_off(c.sv);
+ }
+ op_free(c.rv2cv_op);
+ if (key == METHOD && !PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
+ PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
+ return REPORT(key);
+ }
- case '~':
- return yyl_tilde(aTHX_ s);
+ /* Not a method, so call it a subroutine (if defined) */
- case ',':
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
- TOKEN(0);
- s++;
- OPERATOR(',');
- case ':':
- if (s[1] == ':') {
- len = 0;
- goto just_a_word_zero_gv;
- }
- return yyl_colon(aTHX_ s + 1);
+ if (c.cv) {
+ /* Check for a constant sub */
+ c.sv = cv_const_sv_or_av(c.cv);
+ return yyl_constant_op(aTHX_ s, c.sv, c.cv, c.rv2cv_op, c.off);
+ }
- case '(':
- return yyl_leftparen(aTHX_ s + 1);
+ /* Call it a bare word */
- case ';':
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- TOKEN(0);
- CLINE;
- s++;
- PL_expect = XSTATE;
- TOKEN(';');
+ if (PL_hints & HINT_STRICT_SUBS)
+ pl_yylval.opval->op_private |= OPpCONST_STRICT;
+ else
+ yyl_strictwarn_bareword(aTHX_ lastchar);
- case ')':
- return yyl_rightparen(aTHX_ s);
+ op_free(c.rv2cv_op);
- case ']':
- return yyl_rightsquare(aTHX_ s);
+ return yyl_safe_bareword(aTHX_ s, lastchar);
+}
- case '{':
- s++;
- leftbracket:
- return yyl_leftcurly(aTHX_ s, formbrack);
+static int
+yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct code c)
+{
+ switch (key) {
+ default: /* not a keyword */
+ return yyl_just_a_word(aTHX_ s, len, orig_keyword, c);
+
+ case KEY___FILE__:
+ FUN0OP( newSVOP(OP_CONST, 0, newSVpv(CopFILE(PL_curcop),0)) );
+
+ case KEY___LINE__:
+ FUN0OP(
+ newSVOP(OP_CONST, 0,
+ Perl_newSVpvf(aTHX_ "%" IVdf, (IV)CopLINE(PL_curcop)))
+ );
+
+ case KEY___PACKAGE__:
+ FUN0OP(
+ newSVOP(OP_CONST, 0, (PL_curstash
+ ? newSVhek(HvNAME_HEK(PL_curstash))
+ : &PL_sv_undef))
+ );
+
+ case KEY___DATA__:
+ 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);
+
+ case KEY___SUB__:
+ FUN0OP(CvCLONE(PL_compcv)
+ ? newOP(OP_RUNCV, 0)
+ : newPVOP(OP_RUNCV,0,NULL));
+
+ case KEY_AUTOLOAD:
+ case KEY_DESTROY:
+ case KEY_BEGIN:
+ case KEY_UNITCHECK:
+ case KEY_CHECK:
+ case KEY_INIT:
+ case KEY_END:
+ if (PL_expect == XSTATE)
+ return yyl_sub(aTHX_ PL_bufptr, key);
+ return yyl_just_a_word(aTHX_ s, len, orig_keyword, c);
+
+ case KEY_abs:
+ UNI(OP_ABS);
+
+ case KEY_alarm:
+ UNI(OP_ALARM);
+
+ case KEY_accept:
+ LOP(OP_ACCEPT,XTERM);
+
+ case KEY_and:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
+ return REPORT(0);
+ OPERATOR(ANDOP);
+
+ case KEY_atan2:
+ LOP(OP_ATAN2,XTERM);
+
+ case KEY_bind:
+ LOP(OP_BIND,XTERM);
+
+ case KEY_binmode:
+ LOP(OP_BINMODE,XTERM);
+
+ case KEY_bless:
+ LOP(OP_BLESS,XTERM);
+
+ case KEY_break:
+ FUN0(OP_BREAK);
+
+ case KEY_chop:
+ UNI(OP_CHOP);
+
+ case KEY_continue:
+ /* 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 '}':
- if (PL_lex_brackets && PL_lex_brackstack[PL_lex_brackets-1] == XFAKEEOF)
- TOKEN(0);
- rightbracket:
- assert(s != PL_bufend);
- return yyl_rightcurly(aTHX_ s + 1, formbrack);
+ case KEY_chdir:
+ /* may use HOME */
+ (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV);
+ UNI(OP_CHDIR);
- case '&':
- return yyl_ampersand(aTHX_ s);
+ case KEY_close:
+ UNI(OP_CLOSE);
- case '|':
- return yyl_verticalbar(aTHX_ s);
+ case KEY_closedir:
+ UNI(OP_CLOSEDIR);
- case '=':
- if (s[1] == '=' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), "====="))
- {
- s = vcs_conflict_marker(s + 7);
- return RETRY();
+ case KEY_cmp:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Eop(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);
- s++;
- {
- const char tmp = *s++;
- if (tmp == '=') {
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- {
- s -= 2;
- TOKEN(0);
- }
- Eop(OP_EQ);
- }
- if (tmp == '>') {
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
- {
- s -= 2;
- TOKEN(0);
- }
- 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 && !PL_parser->filtered)
- || PL_lex_state != LEX_NORMAL)
- {
- d = PL_bufend;
- while (s < d) {
- if (*s++ == '\n') {
- incline(s, PL_bufend);
- if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=cut"))
- {
- s = (char *) memchr(s,'\n', d - s);
- if (s)
- s++;
- else
- s = d;
- incline(s, PL_bufend);
- return RETRY();
- }
- }
- }
- return RETRY();
- }
- s = PL_bufend;
- PL_parser->in_pod = 1;
- return RETRY();
- }
- }
- if (PL_expect == XBLOCK) {
- const char *t = s;
-#ifdef PERL_STRICT_CR
- while (SPACE_OR_TAB(*t))
-#else
- while (SPACE_OR_TAB(*t) || *t == '\r')
-#endif
- t++;
- if (*t == '\n' || *t == '#') {
- formbrack = 1;
- ENTER_with_name("lex_format");
- SAVEI8(PL_parser->form_lex_state);
- SAVEI32(PL_lex_formbrack);
- PL_parser->form_lex_state = PL_lex_state;
- PL_lex_formbrack = PL_lex_brackets + 1;
- PL_parser->sub_error_count = PL_error_count;
- goto leftbracket;
- }
- }
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
- s--;
- TOKEN(0);
- }
- pl_yylval.ival = 0;
- OPERATOR(ASSIGNOP);
+ case KEY_chmod:
+ LOP(OP_CHMOD,XTERM);
- case '!':
- return yyl_bang(aTHX_ s + 1);
+ case KEY_chown:
+ LOP(OP_CHOWN,XTERM);
- case '<':
- if (s[1] == '<' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s+2, (STRLEN) (PL_bufend - (s+2)), "<<<<<"))
- {
- s = vcs_conflict_marker(s + 7);
- return RETRY();
- }
- return yyl_leftpointy(aTHX_ s);
+ case KEY_connect:
+ LOP(OP_CONNECT,XTERM);
- case '>':
- if (s[1] == '>' && (s == PL_linestart || s[-1] == '\n')
- && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), ">>>>>"))
- {
- s = vcs_conflict_marker(s + 7);
- return RETRY();
- }
- return yyl_rightpointy(aTHX_ s + 1);
+ case KEY_chr:
+ UNI(OP_CHR);
- case '$':
- return yyl_dollar(aTHX_ s);
+ case KEY_cos:
+ UNI(OP_COS);
- case '@':
- return yyl_snail(aTHX_ s);
+ case KEY_chroot:
+ UNI(OP_CHROOT);
- case '/': /* may be division, defined-or, or pattern */
- return yyl_slash(aTHX_ s);
+ case KEY_default:
+ PREBLOCK(DEFAULT);
- case '?': /* conditional */
- s++;
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_IFELSE)
- {
- s--;
- TOKEN(0);
- }
- PL_lex_allbrackets++;
- OPERATOR('?');
+ case KEY_do:
+ return yyl_do(aTHX_ s, orig_keyword);
- case '.':
- if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
-#ifdef PERL_STRICT_CR
- && s[1] == '\n'
-#else
- && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
-#endif
- && (s == PL_linestart || s[-1] == '\n') )
- {
- PL_expect = XSTATE;
- formbrack = 2; /* dot seen where arguments expected */
- goto rightbracket;
- }
- if (PL_expect == XSTATE && s[1] == '.' && s[2] == '.') {
- s += 3;
- OPERATOR(YADAYADA);
- }
- if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
- char tmp = *s++;
- if (*s == tmp) {
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_RANGE)
- {
- s--;
- TOKEN(0);
- }
- s++;
- if (*s == tmp) {
- s++;
- pl_yylval.ival = OPf_SPECIAL;
- }
- else
- pl_yylval.ival = 0;
- OPERATOR(DOTDOT);
- }
- if (*s == '=' && !PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
- {
- s--;
- TOKEN(0);
- }
- Aop(OP_CONCAT);
- }
- /* FALLTHROUGH */
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- s = scan_num(s, &pl_yylval);
- DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
- if (PL_expect == XOPERATOR)
- no_op("Number",s);
- TERM(THING);
-
- case '\'':
- return yyl_sglquote(aTHX_ s);
-
- case '"':
- return yyl_dblquote(aTHX_ s, len);
-
- case '`':
- return yyl_backtick(aTHX_ s);
-
- case '\\':
- return yyl_backslash(aTHX_ s + 1);
-
- case 'v':
- if (isDIGIT(s[1]) && PL_expect != XOPERATOR) {
- char *start = s + 2;
- while (isDIGIT(*start) || *start == '_')
- start++;
- if (*start == '.' && isDIGIT(start[1])) {
- s = scan_num(s, &pl_yylval);
- TERM(THING);
- }
- else if ((*start == ':' && start[1] == ':')
- || (PL_expect == XSTATE && *start == ':'))
- goto keylookup;
- else if (PL_expect == XSTATE) {
- d = start;
- while (d < PL_bufend && isSPACE(*d)) d++;
- if (*d == ':') goto keylookup;
- }
- /* avoid v123abc() or $h{v1}, allow C<print v10;> */
- if (!isALPHA(*start) && (PL_expect == XTERM
- || PL_expect == XREF || PL_expect == XSTATE
- || PL_expect == XTERMORDORDOR)) {
- GV *const gv = gv_fetchpvn_flags(s, start - s,
- UTF ? SVf_UTF8 : 0, SVt_PVCV);
- if (!gv) {
- s = scan_num(s, &pl_yylval);
- TERM(THING);
- }
- }
- }
- goto keylookup;
- case 'x':
- if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
- s++;
- Mop(OP_REPEAT);
- }
- goto keylookup;
+ case KEY_die:
+ PL_hints |= HINT_BLOCK_SCOPE;
+ LOP(OP_DIE,XTERM);
- case '_':
- case 'a': case 'A':
- case 'b': case 'B':
- case 'c': case 'C':
- case 'd': case 'D':
- case 'e': case 'E':
- case 'f': case 'F':
- case 'g': case 'G':
- case 'h': case 'H':
- case 'i': case 'I':
- case 'j': case 'J':
- case 'k': case 'K':
- case 'l': case 'L':
- case 'm': case 'M':
- case 'n': case 'N':
- case 'o': case 'O':
- case 'p': case 'P':
- case 'q': case 'Q':
- case 'r': case 'R':
- case 's': case 'S':
- case 't': case 'T':
- case 'u': case 'U':
- case 'V':
- case 'w': case 'W':
- case 'X':
- case 'y': case 'Y':
- case 'z': case 'Z':
+ case KEY_defined:
+ UNI(OP_DEFINED);
- keylookup: {
- bool anydelim;
- bool lex = FALSE;
- I32 tmp;
- SV *sv = NULL;
- CV *cv = NULL;
- PADOFFSET off = 0;
- OP *rv2cv_op = NULL;
+ case KEY_delete:
+ UNI(OP_DELETE);
- orig_keyword = 0;
- gv = NULL;
- gvp = NULL;
+ case KEY_dbmopen:
+ Perl_populate_isa(aTHX_ STR_WITH_LEN("AnyDBM_File::ISA"),
+ STR_WITH_LEN("NDBM_File::"),
+ STR_WITH_LEN("DB_File::"),
+ STR_WITH_LEN("GDBM_File::"),
+ STR_WITH_LEN("SDBM_File::"),
+ STR_WITH_LEN("ODBM_File::"),
+ NULL);
+ LOP(OP_DBMOPEN,XTERM);
- PL_bufptr = s;
- s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+ case KEY_dbmclose:
+ UNI(OP_DBMCLOSE);
- /* Some keywords can be followed by any delimiter, including ':' */
- anydelim = word_takes_any_delimiter(PL_tokenbuf, len);
+ case KEY_dump:
+ LOOPX(OP_DUMP);
- /* x::* is just a word, unless x is "CORE" */
- if (!anydelim && *s == ':' && s[1] == ':') {
- if (memEQs(PL_tokenbuf, len, "CORE")) goto case_KEY_CORE;
- goto just_a_word;
- }
+ case KEY_else:
+ PREBLOCK(ELSE);
- d = s;
- while (d < PL_bufend && isSPACE(*d))
- d++; /* no comments skipped here, or s### is misparsed */
+ case KEY_elsif:
+ pl_yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(ELSIF);
- /* Is this a word before a => operator? */
- if (*d == '=' && d[1] == '>') {
- return yyl_fatcomma(aTHX_ s, len);
- }
-
- /* Check for plugged-in keyword */
- {
- OP *o;
- int result;
- char *saved_bufptr = PL_bufptr;
- PL_bufptr = s;
- result = PL_keyword_plugin(aTHX_ PL_tokenbuf, len, &o);
- s = PL_bufptr;
- if (result == KEYWORD_PLUGIN_DECLINE) {
- /* not a plugged-in keyword */
- PL_bufptr = saved_bufptr;
- } else if (result == KEYWORD_PLUGIN_STMT) {
- pl_yylval.opval = o;
- CLINE;
- if (!PL_nexttoke) PL_expect = XSTATE;
- return REPORT(PLUGSTMT);
- } else if (result == KEYWORD_PLUGIN_EXPR) {
- pl_yylval.opval = o;
- CLINE;
- if (!PL_nexttoke) PL_expect = XOPERATOR;
- return REPORT(PLUGEXPR);
- } else {
- Perl_croak(aTHX_ "Bad plugin affecting keyword '%s'",
- PL_tokenbuf);
- }
- }
-
- /* Check for built-in keyword */
- tmp = keyword(PL_tokenbuf, len, 0);
-
- /* Is this a label? */
- if (!anydelim && PL_expect == XSTATE
- && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
- s = d + 1;
- pl_yylval.opval =
- newSVOP(OP_CONST, 0,
- newSVpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0));
- CLINE;
- TOKEN(LABEL);
- }
-
- /* Check for lexical sub */
- if (PL_expect != XOPERATOR) {
- char tmpbuf[sizeof PL_tokenbuf + 1];
- *tmpbuf = '&';
- Copy(PL_tokenbuf, tmpbuf+1, len, char);
- off = pad_findmy_pvn(tmpbuf, len+1, 0);
- if (off != NOT_IN_PAD) {
- assert(off); /* we assume this is boolean-true below */
- if (PAD_COMPNAME_FLAGS_isOUR(off)) {
- HV * const stash = PAD_COMPNAME_OURSTASH(off);
- HEK * const stashname = HvNAME_HEK(stash);
- sv = newSVhek(stashname);
- sv_catpvs(sv, "::");
- sv_catpvn_flags(sv, PL_tokenbuf, len,
- (UTF ? SV_CATUTF8 : SV_CATBYTES));
- gv = gv_fetchsv(sv, GV_NOADD_NOINIT | SvUTF8(sv),
- SVt_PVCV);
- off = 0;
- if (!gv) {
- sv_free(sv);
- sv = NULL;
- goto just_a_word;
- }
- }
- else {
- rv2cv_op = newOP(OP_PADANY, 0);
- rv2cv_op->op_targ = off;
- cv = find_lexical_cv(off);
- }
- lex = TRUE;
- goto just_a_word;
- }
- off = 0;
- }
-
- if (tmp < 0)
- tmp = yyl_secondclass_keyword(aTHX_ s, len, tmp, &orig_keyword, &gv, &gvp);
-
- if (tmp && tmp != KEY___DATA__ && tmp != KEY___END__
- && (!anydelim || *s != '#')) {
- /* no override, and not s### either; skipspace is safe here
- * check for => on following line */
- bool arrow;
- STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr);
- STRLEN soff = s - SvPVX(PL_linestr);
- s = peekspace(s);
- arrow = *s == '=' && s[1] == '>';
- PL_bufptr = SvPVX(PL_linestr) + bufoff;
- s = SvPVX(PL_linestr) + soff;
- if (arrow)
- return yyl_fatcomma(aTHX_ s, len);
- }
-
- reserved_word:
- switch (tmp) {
-
- /* 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. */
- just_a_word_zero_gv:
- sv = NULL;
- cv = NULL;
- gv = NULL;
- gvp = NULL;
- rv2cv_op = NULL;
- orig_keyword = 0;
- lex = 0;
- off = 0;
- /* FALLTHROUGH */
- default: /* not a keyword */
- just_a_word: {
- int pkgname = 0;
- const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
- bool safebw;
- bool no_op_error = FALSE;
-
- if (PL_expect == XOPERATOR) {
- if (PL_bufptr == PL_linestart) {
- CopLINE_dec(PL_curcop);
- Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
- CopLINE_inc(PL_curcop);
- }
- else
- /* We want to call no_op with s pointing after the
- bareword, so defer it. But we want it to come
- before the Bad name croak. */
- no_op_error = TRUE;
- }
-
- /* Get the rest if it looks like a package qualifier */
-
- if (*s == '\'' || (*s == ':' && s[1] == ':')) {
- STRLEN morelen;
- s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
- TRUE, &morelen);
- if (no_op_error) {
- no_op("Bareword",s);
- no_op_error = FALSE;
- }
- if (!morelen)
- Perl_croak(aTHX_ "Bad name after %" UTF8f "%s",
- UTF8fARG(UTF, len, PL_tokenbuf),
- *s == '\'' ? "'" : "::");
- len += morelen;
- pkgname = 1;
- }
-
- if (no_op_error)
- no_op("Bareword",s);
-
- /* See if the name is "Foo::",
- in which case Foo is a bareword
- (and a package name). */
-
- if (len > 2
- && PL_tokenbuf[len - 2] == ':'
- && PL_tokenbuf[len - 1] == ':')
- {
- if (ckWARN(WARN_BAREWORD)
- && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
- Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
- "Bareword \"%" UTF8f
- "\" refers to nonexistent package",
- UTF8fARG(UTF, len, PL_tokenbuf));
- len -= 2;
- PL_tokenbuf[len] = '\0';
- gv = NULL;
- gvp = 0;
- safebw = TRUE;
- }
- else {
- safebw = FALSE;
- }
-
- /* if we saw a global override before, get the right name */
-
- if (!sv)
- sv = S_newSV_maybe_utf8(aTHX_ PL_tokenbuf,
- len);
- if (gvp) {
- SV * const tmp_sv = sv;
- sv = newSVpvs("CORE::GLOBAL::");
- sv_catsv(sv, tmp_sv);
- SvREFCNT_dec(tmp_sv);
- }
+ case KEY_eq:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Eop(OP_SEQ);
+ case KEY_exists:
+ UNI(OP_EXISTS);
- /* Presume this is going to be a bareword of some sort. */
- CLINE;
- pl_yylval.opval = newSVOP(OP_CONST, 0, sv);
- pl_yylval.opval->op_private = OPpCONST_BARE;
+ case KEY_exit:
+ UNI(OP_EXIT);
- /* And if "Foo::", then that's what it certainly is. */
- if (safebw)
- return yyl_safe_bareword(aTHX_ s, lastchar, saw_infix_sigil);
+ case KEY_eval:
+ s = skipspace(s);
+ if (*s == '{') { /* block eval */
+ PL_expect = XTERMBLOCK;
+ UNIBRACK(OP_ENTERTRY);
+ }
+ else { /* string eval */
+ PL_expect = XTERM;
+ UNIBRACK(OP_ENTEREVAL);
+ }
- if (!off)
- {
- OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(sv));
- const_op->op_private = OPpCONST_BARE;
- rv2cv_op =
- newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op);
- cv = lex
- ? isGV(gv)
- ? GvCV(gv)
- : SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV
- ? (CV *)SvRV(gv)
- : ((CV *)gv)
- : rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB);
- }
+ case KEY_evalbytes:
+ PL_expect = XTERM;
+ UNIBRACK(-OP_ENTEREVAL);
- /* Use this var to track whether intuit_method has been
- called. intuit_method returns 0 or > 255. */
- tmp = 1;
+ case KEY_eof:
+ UNI(OP_EOF);
- /* See if it's the indirect object for a list operator. */
+ case KEY_exp:
+ UNI(OP_EXP);
- if (PL_oldoldbufptr
- && PL_oldoldbufptr < PL_bufptr
- && (PL_oldoldbufptr == PL_last_lop
- || PL_oldoldbufptr == PL_last_uni)
- && /* NO SKIPSPACE BEFORE HERE! */
- (PL_expect == XREF
- || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7)
- == OA_FILEREF))
- {
- bool immediate_paren = *s == '(';
- SSize_t s_off;
-
- /* (Now we can afford to cross potential line boundary.) */
- s = skipspace(s);
-
- /* intuit_method() can indirectly call lex_next_chunk(),
- * invalidating s
- */
- s_off = s - SvPVX(PL_linestr);
- /* Two barewords in a row may indicate method call. */
- if ( ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)
- || *s == '$')
- && (tmp = intuit_method(s, lex ? NULL : sv, cv)))
- {
- /* the code at method: doesn't use s */
- goto method;
- }
- s = SvPVX(PL_linestr) + s_off;
-
- /* 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
- || (!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;
- }
- }
+ case KEY_each:
+ UNI(OP_EACH);
- PL_expect = XOPERATOR;
- s = skipspace(s);
-
- /* Is this a word before a => operator? */
- if (*s == '=' && s[1] == '>' && !pkgname) {
- op_free(rv2cv_op);
- CLINE;
- if (gvp || (lex && !off)) {
- assert (cSVOPx(pl_yylval.opval)->op_sv == sv);
- /* This is our own scalar, created a few lines
- above, so this is safe. */
- SvREADONLY_off(sv);
- sv_setpv(sv, PL_tokenbuf);
- if (UTF && !IN_BYTES
- && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(sv);
- SvREADONLY_on(sv);
- }
- TERM(BAREWORD);
- }
+ case KEY_exec:
+ LOP(OP_EXEC,XREF);
- /* If followed by a paren, it's certainly a subroutine. */
- if (*s == '(') {
- CLINE;
- if (cv) {
- d = s + 1;
- while (SPACE_OR_TAB(*d))
- d++;
- if (*d == ')' && (sv = cv_const_sv_or_av(cv))) {
- s = d + 1;
- goto its_constant;
- }
- }
- NEXTVAL_NEXTTOKE.opval =
- off ? rv2cv_op : pl_yylval.opval;
- if (off)
- op_free(pl_yylval.opval), force_next(PRIVATEREF);
- else op_free(rv2cv_op), force_next(BAREWORD);
- pl_yylval.ival = 0;
- TOKEN('&');
- }
+ case KEY_endhostent:
+ FUN0(OP_EHOSTENT);
- /* If followed by var or block, call it a method (unless sub) */
+ case KEY_endnetent:
+ FUN0(OP_ENETENT);
- if ((*s == '$' || *s == '{') && !cv) {
- op_free(rv2cv_op);
- PL_last_lop = PL_oldbufptr;
- PL_last_lop_op = OP_METHOD;
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
- {
- PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- }
- PL_expect = XBLOCKTERM;
- PL_bufptr = s;
- return REPORT(METHOD);
- }
+ case KEY_endservent:
+ FUN0(OP_ESERVENT);
- /* If followed by a bareword, see if it looks like indir obj. */
+ case KEY_endprotoent:
+ FUN0(OP_EPROTOENT);
- if ( tmp == 1
- && !orig_keyword
- && (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || *s == '$')
- && (tmp = intuit_method(s, lex ? NULL : sv, cv)))
- {
- method:
- if (lex && !off) {
- assert(cSVOPx(pl_yylval.opval)->op_sv == sv);
- SvREADONLY_off(sv);
- sv_setpvn(sv, PL_tokenbuf, len);
- if (UTF && !IN_BYTES
- && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on (sv);
- else SvUTF8_off(sv);
- }
- op_free(rv2cv_op);
- if (tmp == METHOD && !PL_lex_allbrackets
- && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
- {
- PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- }
- return REPORT(tmp);
- }
+ case KEY_endpwent:
+ FUN0(OP_EPWENT);
- /* Not a method, so call it a subroutine (if defined) */
-
- if (cv) {
- /* Check for a constant sub */
- if ((sv = cv_const_sv_or_av(cv))) {
- its_constant:
- op_free(rv2cv_op);
- SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
- ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
- if (SvTYPE(sv) == SVt_PVAV)
- pl_yylval.opval = newUNOP(OP_RV2AV, OPf_PARENS,
- pl_yylval.opval);
- else {
- pl_yylval.opval->op_private = 0;
- pl_yylval.opval->op_folded = 1;
- pl_yylval.opval->op_flags |= OPf_SPECIAL;
- }
- TOKEN(BAREWORD);
- }
+ case KEY_endgrent:
+ FUN0(OP_EGRENT);
- op_free(pl_yylval.opval);
- pl_yylval.opval =
- off ? newCVREF(0, rv2cv_op) : rv2cv_op;
- pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
- PL_last_lop = PL_oldbufptr;
- PL_last_lop_op = OP_ENTERSUB;
-
- /* Is there a prototype? */
- if (SvPOK(cv)) {
- int k = yyl_subproto(aTHX_ s, cv);
- if (k != KEY_NULL)
- return k;
- }
+ case KEY_for:
+ case KEY_foreach:
+ return yyl_foreach(aTHX_ s);
- NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
- PL_expect = XTERM;
- force_next(off ? PRIVATEREF : BAREWORD);
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
- {
- PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- }
- TOKEN(NOAMP);
- }
+ case KEY_formline:
+ LOP(OP_FORMLINE,XTERM);
- /* Call it a bare word */
+ case KEY_fork:
+ FUN0(OP_FORK);
- if (PL_hints & HINT_STRICT_SUBS)
- pl_yylval.opval->op_private |= OPpCONST_STRICT;
- else {
- bareword:
- /* after "print" and similar functions (corresponding to
- * "F? L" in opcode.pl), whatever wasn't already parsed as
- * a filehandle should be subject to "strict subs".
- * Likewise for the optional indirect-object argument to system
- * or exec, which can't be a bareword */
- if ((PL_last_lop_op == OP_PRINT
- || PL_last_lop_op == OP_PRTF
- || PL_last_lop_op == OP_SAY
- || PL_last_lop_op == OP_SYSTEM
- || PL_last_lop_op == OP_EXEC)
- && (PL_hints & HINT_STRICT_SUBS))
- pl_yylval.opval->op_private |= OPpCONST_STRICT;
- if (lastchar != '-') {
- if (ckWARN(WARN_RESERVED)) {
- d = PL_tokenbuf;
- while (isLOWER(*d))
- d++;
- if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0))
- {
- /* PL_warn_reserved is constant */
- GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
- Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
- PL_tokenbuf);
- GCC_DIAG_RESTORE_STMT;
- }
- }
- }
- }
- op_free(rv2cv_op);
+ case KEY_fc:
+ UNI(OP_FC);
- return yyl_safe_bareword(aTHX_ s, lastchar, saw_infix_sigil);
- }
+ case KEY_fcntl:
+ LOP(OP_FCNTL,XTERM);
- case KEY___FILE__:
- FUN0OP(
- newSVOP(OP_CONST, 0, newSVpv(CopFILE(PL_curcop),0))
- );
-
- case KEY___LINE__:
- FUN0OP(
- newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%" IVdf, (IV)CopLINE(PL_curcop)))
- );
-
- case KEY___PACKAGE__:
- FUN0OP(
- newSVOP(OP_CONST, 0,
- (PL_curstash
- ? newSVhek(HvNAME_HEK(PL_curstash))
- : &PL_sv_undef))
- );
-
- case KEY___DATA__:
- 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, bof, s, len,
- orig_keyword, gv, gvp, formbrack, saw_infix_sigil);
-
- case KEY___SUB__:
- FUN0OP(CvCLONE(PL_compcv)
- ? newOP(OP_RUNCV, 0)
- : newPVOP(OP_RUNCV,0,NULL));
-
- case KEY_AUTOLOAD:
- case KEY_DESTROY:
- case KEY_BEGIN:
- case KEY_UNITCHECK:
- case KEY_CHECK:
- case KEY_INIT:
- case KEY_END:
- if (PL_expect == XSTATE) {
- s = PL_bufptr;
- goto really_sub;
- }
- goto just_a_word;
+ case KEY_fileno:
+ UNI(OP_FILENO);
- case_KEY_CORE:
- {
- STRLEN olen = len;
- d = s;
- s += 2;
- s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
- if ((*s == ':' && s[1] == ':')
- || (!(tmp = keyword(PL_tokenbuf, len, 1)) && *s == '\''))
- {
- s = d;
- len = olen;
- Copy(PL_bufptr, PL_tokenbuf, olen, char);
- goto just_a_word;
- }
- if (!tmp)
- Perl_croak(aTHX_ "CORE::%" UTF8f " is not a keyword",
- UTF8fARG(UTF, len, PL_tokenbuf));
- if (tmp < 0)
- tmp = -tmp;
- else if (tmp == KEY_require || tmp == KEY_do
- || tmp == KEY_glob)
- /* that's a way to remember we saw "CORE::" */
- orig_keyword = tmp;
- goto reserved_word;
- }
+ case KEY_flock:
+ LOP(OP_FLOCK,XTERM);
- case KEY_abs:
- UNI(OP_ABS);
+ case KEY_gt:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Rop(OP_SGT);
- case KEY_alarm:
- UNI(OP_ALARM);
+ case KEY_ge:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Rop(OP_SGE);
- case KEY_accept:
- LOP(OP_ACCEPT,XTERM);
+ case KEY_grep:
+ LOP(OP_GREPSTART, XREF);
- case KEY_and:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
- return REPORT(0);
- OPERATOR(ANDOP);
+ case KEY_goto:
+ LOOPX(OP_GOTO);
- case KEY_atan2:
- LOP(OP_ATAN2,XTERM);
+ case KEY_gmtime:
+ UNI(OP_GMTIME);
- case KEY_bind:
- LOP(OP_BIND,XTERM);
+ case KEY_getc:
+ UNIDOR(OP_GETC);
- case KEY_binmode:
- LOP(OP_BINMODE,XTERM);
+ case KEY_getppid:
+ FUN0(OP_GETPPID);
- case KEY_bless:
- LOP(OP_BLESS,XTERM);
+ case KEY_getpgrp:
+ UNI(OP_GETPGRP);
- case KEY_break:
- FUN0(OP_BREAK);
+ case KEY_getpriority:
+ LOP(OP_GETPRIORITY,XTERM);
- case KEY_chop:
- UNI(OP_CHOP);
+ case KEY_getprotobyname:
+ UNI(OP_GPBYNAME);
- case KEY_continue:
- /* 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_getprotobynumber:
+ LOP(OP_GPBYNUMBER,XTERM);
- case KEY_chdir:
- /* may use HOME */
- (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV);
- UNI(OP_CHDIR);
+ case KEY_getprotoent:
+ FUN0(OP_GPROTOENT);
- case KEY_close:
- UNI(OP_CLOSE);
+ case KEY_getpwent:
+ FUN0(OP_GPWENT);
- case KEY_closedir:
- UNI(OP_CLOSEDIR);
+ case KEY_getpwnam:
+ UNI(OP_GPWNAM);
- case KEY_cmp:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Eop(OP_SCMP);
+ case KEY_getpwuid:
+ UNI(OP_GPWUID);
- case KEY_caller:
- UNI(OP_CALLER);
+ case KEY_getpeername:
+ UNI(OP_GETPEERNAME);
- case KEY_crypt:
-#ifdef FCRYPT
- if (!PL_cryptseen) {
- PL_cryptseen = TRUE;
- init_des();
- }
-#endif
- LOP(OP_CRYPT,XTERM);
+ case KEY_gethostbyname:
+ UNI(OP_GHBYNAME);
- case KEY_chmod:
- LOP(OP_CHMOD,XTERM);
+ case KEY_gethostbyaddr:
+ LOP(OP_GHBYADDR,XTERM);
- case KEY_chown:
- LOP(OP_CHOWN,XTERM);
+ case KEY_gethostent:
+ FUN0(OP_GHOSTENT);
- case KEY_connect:
- LOP(OP_CONNECT,XTERM);
+ case KEY_getnetbyname:
+ UNI(OP_GNBYNAME);
- case KEY_chr:
- UNI(OP_CHR);
+ case KEY_getnetbyaddr:
+ LOP(OP_GNBYADDR,XTERM);
- case KEY_cos:
- UNI(OP_COS);
+ case KEY_getnetent:
+ FUN0(OP_GNETENT);
- case KEY_chroot:
- UNI(OP_CHROOT);
+ case KEY_getservbyname:
+ LOP(OP_GSBYNAME,XTERM);
- case KEY_default:
- PREBLOCK(DEFAULT);
+ case KEY_getservbyport:
+ LOP(OP_GSBYPORT,XTERM);
- case KEY_do:
- return yyl_do(aTHX_ s, orig_keyword);
+ case KEY_getservent:
+ FUN0(OP_GSERVENT);
- case KEY_die:
- PL_hints |= HINT_BLOCK_SCOPE;
- LOP(OP_DIE,XTERM);
+ case KEY_getsockname:
+ UNI(OP_GETSOCKNAME);
- case KEY_defined:
- UNI(OP_DEFINED);
+ case KEY_getsockopt:
+ LOP(OP_GSOCKOPT,XTERM);
- case KEY_delete:
- UNI(OP_DELETE);
+ case KEY_getgrent:
+ FUN0(OP_GGRENT);
- case KEY_dbmopen:
- Perl_populate_isa(aTHX_ STR_WITH_LEN("AnyDBM_File::ISA"),
- STR_WITH_LEN("NDBM_File::"),
- STR_WITH_LEN("DB_File::"),
- STR_WITH_LEN("GDBM_File::"),
- STR_WITH_LEN("SDBM_File::"),
- STR_WITH_LEN("ODBM_File::"),
- NULL);
- LOP(OP_DBMOPEN,XTERM);
+ case KEY_getgrnam:
+ UNI(OP_GGRNAM);
- case KEY_dbmclose:
- UNI(OP_DBMCLOSE);
+ case KEY_getgrgid:
+ UNI(OP_GGRGID);
- case KEY_dump:
- LOOPX(OP_DUMP);
+ case KEY_getlogin:
+ FUN0(OP_GETLOGIN);
- case KEY_else:
- PREBLOCK(ELSE);
+ case KEY_given:
+ pl_yylval.ival = CopLINE(PL_curcop);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
+ "given is experimental");
+ OPERATOR(GIVEN);
- case KEY_elsif:
- pl_yylval.ival = CopLINE(PL_curcop);
- OPERATOR(ELSIF);
+ case KEY_glob:
+ LOP( orig_keyword==KEY_glob ? -OP_GLOB : OP_GLOB, XTERM );
- case KEY_eq:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Eop(OP_SEQ);
+ case KEY_hex:
+ UNI(OP_HEX);
- case KEY_exists:
- UNI(OP_EXISTS);
+ case KEY_if:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ return REPORT(0);
+ pl_yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(IF);
- case KEY_exit:
- UNI(OP_EXIT);
+ case KEY_index:
+ LOP(OP_INDEX,XTERM);
- case KEY_eval:
- s = skipspace(s);
- if (*s == '{') { /* block eval */
- PL_expect = XTERMBLOCK;
- UNIBRACK(OP_ENTERTRY);
- }
- else { /* string eval */
- PL_expect = XTERM;
- UNIBRACK(OP_ENTEREVAL);
- }
+ case KEY_int:
+ UNI(OP_INT);
- case KEY_evalbytes:
- PL_expect = XTERM;
- UNIBRACK(-OP_ENTEREVAL);
+ case KEY_ioctl:
+ LOP(OP_IOCTL,XTERM);
- case KEY_eof:
- UNI(OP_EOF);
+ case KEY_join:
+ LOP(OP_JOIN,XTERM);
- case KEY_exp:
- UNI(OP_EXP);
+ case KEY_keys:
+ UNI(OP_KEYS);
- case KEY_each:
- UNI(OP_EACH);
+ case KEY_kill:
+ LOP(OP_KILL,XTERM);
- case KEY_exec:
- LOP(OP_EXEC,XREF);
+ case KEY_last:
+ LOOPX(OP_LAST);
- case KEY_endhostent:
- FUN0(OP_EHOSTENT);
+ case KEY_lc:
+ UNI(OP_LC);
- case KEY_endnetent:
- FUN0(OP_ENETENT);
+ case KEY_lcfirst:
+ UNI(OP_LCFIRST);
- case KEY_endservent:
- FUN0(OP_ESERVENT);
+ case KEY_local:
+ OPERATOR(LOCAL);
- case KEY_endprotoent:
- FUN0(OP_EPROTOENT);
+ case KEY_length:
+ UNI(OP_LENGTH);
- case KEY_endpwent:
- FUN0(OP_EPWENT);
+ case KEY_lt:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Rop(OP_SLT);
- case KEY_endgrent:
- FUN0(OP_EGRENT);
+ case KEY_le:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Rop(OP_SLE);
- case KEY_for:
- case KEY_foreach:
- return yyl_foreach(aTHX_ s);
+ case KEY_localtime:
+ UNI(OP_LOCALTIME);
- case KEY_formline:
- LOP(OP_FORMLINE,XTERM);
+ case KEY_log:
+ UNI(OP_LOG);
- case KEY_fork:
- FUN0(OP_FORK);
+ case KEY_link:
+ LOP(OP_LINK,XTERM);
- case KEY_fc:
- UNI(OP_FC);
+ case KEY_listen:
+ LOP(OP_LISTEN,XTERM);
- case KEY_fcntl:
- LOP(OP_FCNTL,XTERM);
+ case KEY_lock:
+ UNI(OP_LOCK);
- case KEY_fileno:
- UNI(OP_FILENO);
+ case KEY_lstat:
+ UNI(OP_LSTAT);
- case KEY_flock:
- LOP(OP_FLOCK,XTERM);
+ case KEY_m:
+ s = scan_pat(s,OP_MATCH);
+ TERM(sublex_start());
- case KEY_gt:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Rop(OP_SGT);
+ case KEY_map:
+ LOP(OP_MAPSTART, XREF);
- case KEY_ge:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Rop(OP_SGE);
+ case KEY_mkdir:
+ LOP(OP_MKDIR,XTERM);
- case KEY_grep:
- LOP(OP_GREPSTART, XREF);
+ case KEY_msgctl:
+ LOP(OP_MSGCTL,XTERM);
- case KEY_goto:
- LOOPX(OP_GOTO);
+ case KEY_msgget:
+ LOP(OP_MSGGET,XTERM);
- case KEY_gmtime:
- UNI(OP_GMTIME);
+ case KEY_msgrcv:
+ LOP(OP_MSGRCV,XTERM);
- case KEY_getc:
- UNIDOR(OP_GETC);
+ case KEY_msgsnd:
+ LOP(OP_MSGSND,XTERM);
- case KEY_getppid:
- FUN0(OP_GETPPID);
+ case KEY_our:
+ case KEY_my:
+ case KEY_state:
+ return yyl_my(aTHX_ s, key);
- case KEY_getpgrp:
- UNI(OP_GETPGRP);
+ case KEY_next:
+ LOOPX(OP_NEXT);
- case KEY_getpriority:
- LOP(OP_GETPRIORITY,XTERM);
+ case KEY_ne:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ return REPORT(0);
+ Eop(OP_SNE);
- case KEY_getprotobyname:
- UNI(OP_GPBYNAME);
+ case KEY_no:
+ s = tokenize_use(0, s);
+ TOKEN(USE);
- case KEY_getprotobynumber:
- LOP(OP_GPBYNUMBER,XTERM);
+ case KEY_not:
+ if (*s == '(' || (s = skipspace(s), *s == '('))
+ FUN1(OP_NOT);
+ else {
+ if (!PL_lex_allbrackets && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ OPERATOR(NOTOP);
+ }
- case KEY_getprotoent:
- FUN0(OP_GPROTOENT);
+ case KEY_open:
+ s = skipspace(s);
+ if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) {
+ const char *t;
+ char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+ for (t=d; isSPACE(*t);)
+ t++;
+ if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
+ /* [perl #16184] */
+ && !(t[0] == '=' && t[1] == '>')
+ && !(t[0] == ':' && t[1] == ':')
+ && !keyword(s, d-s, 0)
+ ) {
+ Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
+ "Precedence problem: open %" UTF8f " should be open(%" UTF8f ")",
+ UTF8fARG(UTF, d-s, s), UTF8fARG(UTF, d-s, s));
+ }
+ }
+ LOP(OP_OPEN,XTERM);
- case KEY_getpwent:
- FUN0(OP_GPWENT);
+ case KEY_or:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
+ return REPORT(0);
+ pl_yylval.ival = OP_OR;
+ OPERATOR(OROP);
- case KEY_getpwnam:
- UNI(OP_GPWNAM);
+ case KEY_ord:
+ UNI(OP_ORD);
- case KEY_getpwuid:
- UNI(OP_GPWUID);
+ case KEY_oct:
+ UNI(OP_OCT);
- case KEY_getpeername:
- UNI(OP_GETPEERNAME);
+ case KEY_opendir:
+ LOP(OP_OPEN_DIR,XTERM);
- case KEY_gethostbyname:
- UNI(OP_GHBYNAME);
+ case KEY_print:
+ checkcomma(s,PL_tokenbuf,"filehandle");
+ LOP(OP_PRINT,XREF);
- case KEY_gethostbyaddr:
- LOP(OP_GHBYADDR,XTERM);
+ case KEY_printf:
+ checkcomma(s,PL_tokenbuf,"filehandle");
+ LOP(OP_PRTF,XREF);
- case KEY_gethostent:
- FUN0(OP_GHOSTENT);
+ case KEY_prototype:
+ UNI(OP_PROTOTYPE);
- case KEY_getnetbyname:
- UNI(OP_GNBYNAME);
+ case KEY_push:
+ LOP(OP_PUSH,XTERM);
- case KEY_getnetbyaddr:
- LOP(OP_GNBYADDR,XTERM);
+ case KEY_pop:
+ UNIDOR(OP_POP);
- case KEY_getnetent:
- FUN0(OP_GNETENT);
+ case KEY_pos:
+ UNIDOR(OP_POS);
- case KEY_getservbyname:
- LOP(OP_GSBYNAME,XTERM);
+ case KEY_pack:
+ LOP(OP_PACK,XTERM);
- case KEY_getservbyport:
- LOP(OP_GSBYPORT,XTERM);
+ case KEY_package:
+ s = force_word(s,BAREWORD,FALSE,TRUE);
+ s = skipspace(s);
+ s = force_strict_version(s);
+ PREBLOCK(PACKAGE);
- case KEY_getservent:
- FUN0(OP_GSERVENT);
+ case KEY_pipe:
+ LOP(OP_PIPE_OP,XTERM);
- case KEY_getsockname:
- UNI(OP_GETSOCKNAME);
+ case KEY_q:
+ s = scan_str(s,FALSE,FALSE,FALSE,NULL);
+ if (!s)
+ missingterm(NULL, 0);
+ COPLINE_SET_FROM_MULTI_END;
+ pl_yylval.ival = OP_CONST;
+ TERM(sublex_start());
- case KEY_getsockopt:
- LOP(OP_GSOCKOPT,XTERM);
+ case KEY_quotemeta:
+ UNI(OP_QUOTEMETA);
- case KEY_getgrent:
- FUN0(OP_GGRENT);
+ case KEY_qw:
+ return yyl_qw(aTHX_ s, len);
- case KEY_getgrnam:
- UNI(OP_GGRNAM);
+ case KEY_qq:
+ s = scan_str(s,FALSE,FALSE,FALSE,NULL);
+ if (!s)
+ missingterm(NULL, 0);
+ pl_yylval.ival = OP_STRINGIFY;
+ if (SvIVX(PL_lex_stuff) == '\'')
+ SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should interpolate */
+ TERM(sublex_start());
- case KEY_getgrgid:
- UNI(OP_GGRGID);
+ case KEY_qr:
+ s = scan_pat(s,OP_QR);
+ TERM(sublex_start());
- case KEY_getlogin:
- FUN0(OP_GETLOGIN);
+ case KEY_qx:
+ s = scan_str(s,FALSE,FALSE,FALSE,NULL);
+ if (!s)
+ missingterm(NULL, 0);
+ pl_yylval.ival = OP_BACKTICK;
+ TERM(sublex_start());
- case KEY_given:
- pl_yylval.ival = CopLINE(PL_curcop);
- Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
- "given is experimental");
- OPERATOR(GIVEN);
+ case KEY_return:
+ OLDLOP(OP_RETURN);
- case KEY_glob:
- LOP(
- orig_keyword==KEY_glob ? -OP_GLOB : OP_GLOB,
- XTERM
- );
+ case KEY_require:
+ return yyl_require(aTHX_ s, orig_keyword);
- case KEY_hex:
- UNI(OP_HEX);
+ case KEY_reset:
+ UNI(OP_RESET);
- case KEY_if:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- return REPORT(0);
- pl_yylval.ival = CopLINE(PL_curcop);
- OPERATOR(IF);
+ case KEY_redo:
+ LOOPX(OP_REDO);
- case KEY_index:
- LOP(OP_INDEX,XTERM);
+ case KEY_rename:
+ LOP(OP_RENAME,XTERM);
- case KEY_int:
- UNI(OP_INT);
+ case KEY_rand:
+ UNI(OP_RAND);
- case KEY_ioctl:
- LOP(OP_IOCTL,XTERM);
+ case KEY_rmdir:
+ UNI(OP_RMDIR);
- case KEY_join:
- LOP(OP_JOIN,XTERM);
+ case KEY_rindex:
+ LOP(OP_RINDEX,XTERM);
- case KEY_keys:
- UNI(OP_KEYS);
+ case KEY_read:
+ LOP(OP_READ,XTERM);
- case KEY_kill:
- LOP(OP_KILL,XTERM);
+ case KEY_readdir:
+ UNI(OP_READDIR);
- case KEY_last:
- LOOPX(OP_LAST);
+ case KEY_readline:
+ UNIDOR(OP_READLINE);
- case KEY_lc:
- UNI(OP_LC);
+ case KEY_readpipe:
+ UNIDOR(OP_BACKTICK);
- case KEY_lcfirst:
- UNI(OP_LCFIRST);
+ case KEY_rewinddir:
+ UNI(OP_REWINDDIR);
- case KEY_local:
- OPERATOR(LOCAL);
+ case KEY_recv:
+ LOP(OP_RECV,XTERM);
- case KEY_length:
- UNI(OP_LENGTH);
+ case KEY_reverse:
+ LOP(OP_REVERSE,XTERM);
- case KEY_lt:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Rop(OP_SLT);
+ case KEY_readlink:
+ UNIDOR(OP_READLINK);
- case KEY_le:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Rop(OP_SLE);
+ case KEY_ref:
+ UNI(OP_REF);
- case KEY_localtime:
- UNI(OP_LOCALTIME);
+ case KEY_s:
+ s = scan_subst(s);
+ if (pl_yylval.opval)
+ TERM(sublex_start());
+ else
+ TOKEN(1); /* force error */
- case KEY_log:
- UNI(OP_LOG);
+ case KEY_say:
+ checkcomma(s,PL_tokenbuf,"filehandle");
+ LOP(OP_SAY,XREF);
- case KEY_link:
- LOP(OP_LINK,XTERM);
+ case KEY_chomp:
+ UNI(OP_CHOMP);
- case KEY_listen:
- LOP(OP_LISTEN,XTERM);
+ case KEY_scalar:
+ UNI(OP_SCALAR);
- case KEY_lock:
- UNI(OP_LOCK);
+ case KEY_select:
+ LOP(OP_SELECT,XTERM);
- case KEY_lstat:
- UNI(OP_LSTAT);
+ case KEY_seek:
+ LOP(OP_SEEK,XTERM);
- case KEY_m:
- s = scan_pat(s,OP_MATCH);
- TERM(sublex_start());
+ case KEY_semctl:
+ LOP(OP_SEMCTL,XTERM);
- case KEY_map:
- LOP(OP_MAPSTART, XREF);
+ case KEY_semget:
+ LOP(OP_SEMGET,XTERM);
- case KEY_mkdir:
- LOP(OP_MKDIR,XTERM);
+ case KEY_semop:
+ LOP(OP_SEMOP,XTERM);
- case KEY_msgctl:
- LOP(OP_MSGCTL,XTERM);
+ case KEY_send:
+ LOP(OP_SEND,XTERM);
- case KEY_msgget:
- LOP(OP_MSGGET,XTERM);
+ case KEY_setpgrp:
+ LOP(OP_SETPGRP,XTERM);
- case KEY_msgrcv:
- LOP(OP_MSGRCV,XTERM);
+ case KEY_setpriority:
+ LOP(OP_SETPRIORITY,XTERM);
- case KEY_msgsnd:
- LOP(OP_MSGSND,XTERM);
+ case KEY_sethostent:
+ UNI(OP_SHOSTENT);
- case KEY_our:
- case KEY_my:
- case KEY_state: {
- int tok = yyl_my(aTHX_ &s, tmp);
- if (tok == SUB)
- goto really_sub;
- else
- return tok;
- }
+ case KEY_setnetent:
+ UNI(OP_SNETENT);
- case KEY_next:
- LOOPX(OP_NEXT);
+ case KEY_setservent:
+ UNI(OP_SSERVENT);
- case KEY_ne:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
- return REPORT(0);
- Eop(OP_SNE);
+ case KEY_setprotoent:
+ UNI(OP_SPROTOENT);
- case KEY_no:
- s = tokenize_use(0, s);
- TOKEN(USE);
+ case KEY_setpwent:
+ FUN0(OP_SPWENT);
- case KEY_not:
- if (*s == '(' || (s = skipspace(s), *s == '('))
- FUN1(OP_NOT);
- else {
- if (!PL_lex_allbrackets
- && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
- {
- PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- }
- OPERATOR(NOTOP);
- }
+ case KEY_setgrent:
+ FUN0(OP_SGRENT);
- case KEY_open:
- s = skipspace(s);
- if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) {
- const char *t;
- d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE,
- &len);
- for (t=d; isSPACE(*t);)
- t++;
- if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
- /* [perl #16184] */
- && !(t[0] == '=' && t[1] == '>')
- && !(t[0] == ':' && t[1] == ':')
- && !keyword(s, d-s, 0)
- ) {
- Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
- "Precedence problem: open %" UTF8f " should be open(%" UTF8f ")",
- UTF8fARG(UTF, d-s, s), UTF8fARG(UTF, d-s, s));
- }
- }
- LOP(OP_OPEN,XTERM);
+ case KEY_seekdir:
+ LOP(OP_SEEKDIR,XTERM);
- case KEY_or:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
- return REPORT(0);
- pl_yylval.ival = OP_OR;
- OPERATOR(OROP);
+ case KEY_setsockopt:
+ LOP(OP_SSOCKOPT,XTERM);
- case KEY_ord:
- UNI(OP_ORD);
+ case KEY_shift:
+ UNIDOR(OP_SHIFT);
- case KEY_oct:
- UNI(OP_OCT);
+ case KEY_shmctl:
+ LOP(OP_SHMCTL,XTERM);
- case KEY_opendir:
- LOP(OP_OPEN_DIR,XTERM);
+ case KEY_shmget:
+ LOP(OP_SHMGET,XTERM);
- case KEY_print:
- checkcomma(s,PL_tokenbuf,"filehandle");
- LOP(OP_PRINT,XREF);
+ case KEY_shmread:
+ LOP(OP_SHMREAD,XTERM);
- case KEY_printf:
- checkcomma(s,PL_tokenbuf,"filehandle");
- LOP(OP_PRTF,XREF);
+ case KEY_shmwrite:
+ LOP(OP_SHMWRITE,XTERM);
- case KEY_prototype:
- UNI(OP_PROTOTYPE);
+ case KEY_shutdown:
+ LOP(OP_SHUTDOWN,XTERM);
- case KEY_push:
- LOP(OP_PUSH,XTERM);
+ case KEY_sin:
+ UNI(OP_SIN);
- case KEY_pop:
- UNIDOR(OP_POP);
+ case KEY_sleep:
+ UNI(OP_SLEEP);
- case KEY_pos:
- UNIDOR(OP_POS);
+ case KEY_socket:
+ LOP(OP_SOCKET,XTERM);
- case KEY_pack:
- LOP(OP_PACK,XTERM);
+ case KEY_socketpair:
+ LOP(OP_SOCKPAIR,XTERM);
- case KEY_package:
- s = force_word(s,BAREWORD,FALSE,TRUE);
- s = skipspace(s);
- s = force_strict_version(s);
- PREBLOCK(PACKAGE);
+ case KEY_sort:
+ checkcomma(s,PL_tokenbuf,"subroutine name");
+ s = skipspace(s);
+ PL_expect = XTERM;
+ s = force_word(s,BAREWORD,TRUE,TRUE);
+ LOP(OP_SORT,XREF);
- case KEY_pipe:
- LOP(OP_PIPE_OP,XTERM);
+ case KEY_split:
+ LOP(OP_SPLIT,XTERM);
- case KEY_q:
- s = scan_str(s,FALSE,FALSE,FALSE,NULL);
- if (!s)
- missingterm(NULL, 0);
- COPLINE_SET_FROM_MULTI_END;
- pl_yylval.ival = OP_CONST;
- TERM(sublex_start());
+ case KEY_sprintf:
+ LOP(OP_SPRINTF,XTERM);
- case KEY_quotemeta:
- UNI(OP_QUOTEMETA);
+ case KEY_splice:
+ LOP(OP_SPLICE,XTERM);
- case KEY_qw:
- return yyl_qw(aTHX_ s, len);
+ case KEY_sqrt:
+ UNI(OP_SQRT);
- case KEY_qq:
- s = scan_str(s,FALSE,FALSE,FALSE,NULL);
- if (!s)
- missingterm(NULL, 0);
- pl_yylval.ival = OP_STRINGIFY;
- if (SvIVX(PL_lex_stuff) == '\'')
- SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should interpolate */
- TERM(sublex_start());
-
- case KEY_qr:
- s = scan_pat(s,OP_QR);
- TERM(sublex_start());
-
- case KEY_qx:
- s = scan_str(s,FALSE,FALSE,FALSE,NULL);
- if (!s)
- missingterm(NULL, 0);
- pl_yylval.ival = OP_BACKTICK;
- TERM(sublex_start());
+ case KEY_srand:
+ UNI(OP_SRAND);
- case KEY_return:
- OLDLOP(OP_RETURN);
+ case KEY_stat:
+ UNI(OP_STAT);
- case KEY_require:
- return yyl_require(aTHX_ s, orig_keyword);
+ case KEY_study:
+ UNI(OP_STUDY);
- case KEY_reset:
- UNI(OP_RESET);
+ case KEY_substr:
+ LOP(OP_SUBSTR,XTERM);
- case KEY_redo:
- LOOPX(OP_REDO);
+ case KEY_format:
+ case KEY_sub:
+ return yyl_sub(aTHX_ s, key);
- case KEY_rename:
- LOP(OP_RENAME,XTERM);
+ case KEY_system:
+ LOP(OP_SYSTEM,XREF);
- case KEY_rand:
- UNI(OP_RAND);
+ case KEY_symlink:
+ LOP(OP_SYMLINK,XTERM);
- case KEY_rmdir:
- UNI(OP_RMDIR);
+ case KEY_syscall:
+ LOP(OP_SYSCALL,XTERM);
- case KEY_rindex:
- LOP(OP_RINDEX,XTERM);
+ case KEY_sysopen:
+ LOP(OP_SYSOPEN,XTERM);
- case KEY_read:
- LOP(OP_READ,XTERM);
+ case KEY_sysseek:
+ LOP(OP_SYSSEEK,XTERM);
- case KEY_readdir:
- UNI(OP_READDIR);
+ case KEY_sysread:
+ LOP(OP_SYSREAD,XTERM);
- case KEY_readline:
- UNIDOR(OP_READLINE);
+ case KEY_syswrite:
+ LOP(OP_SYSWRITE,XTERM);
- case KEY_readpipe:
- UNIDOR(OP_BACKTICK);
+ case KEY_tr:
+ case KEY_y:
+ s = scan_trans(s);
+ TERM(sublex_start());
- case KEY_rewinddir:
- UNI(OP_REWINDDIR);
+ case KEY_tell:
+ UNI(OP_TELL);
- case KEY_recv:
- LOP(OP_RECV,XTERM);
+ case KEY_telldir:
+ UNI(OP_TELLDIR);
- case KEY_reverse:
- LOP(OP_REVERSE,XTERM);
+ case KEY_tie:
+ LOP(OP_TIE,XTERM);
- case KEY_readlink:
- UNIDOR(OP_READLINK);
+ case KEY_tied:
+ UNI(OP_TIED);
- case KEY_ref:
- UNI(OP_REF);
+ case KEY_time:
+ FUN0(OP_TIME);
- case KEY_s:
- s = scan_subst(s);
- if (pl_yylval.opval)
- TERM(sublex_start());
- else
- TOKEN(1); /* force error */
+ case KEY_times:
+ FUN0(OP_TMS);
- case KEY_say:
- checkcomma(s,PL_tokenbuf,"filehandle");
- LOP(OP_SAY,XREF);
+ case KEY_truncate:
+ LOP(OP_TRUNCATE,XTERM);
- case KEY_chomp:
- UNI(OP_CHOMP);
+ case KEY_uc:
+ UNI(OP_UC);
- case KEY_scalar:
- UNI(OP_SCALAR);
+ case KEY_ucfirst:
+ UNI(OP_UCFIRST);
- case KEY_select:
- LOP(OP_SELECT,XTERM);
+ case KEY_untie:
+ UNI(OP_UNTIE);
- case KEY_seek:
- LOP(OP_SEEK,XTERM);
+ case KEY_until:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ return REPORT(0);
+ pl_yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(UNTIL);
- case KEY_semctl:
- LOP(OP_SEMCTL,XTERM);
+ case KEY_unless:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ return REPORT(0);
+ pl_yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(UNLESS);
- case KEY_semget:
- LOP(OP_SEMGET,XTERM);
+ case KEY_unlink:
+ LOP(OP_UNLINK,XTERM);
- case KEY_semop:
- LOP(OP_SEMOP,XTERM);
+ case KEY_undef:
+ UNIDOR(OP_UNDEF);
- case KEY_send:
- LOP(OP_SEND,XTERM);
+ case KEY_unpack:
+ LOP(OP_UNPACK,XTERM);
- case KEY_setpgrp:
- LOP(OP_SETPGRP,XTERM);
+ case KEY_utime:
+ LOP(OP_UTIME,XTERM);
- case KEY_setpriority:
- LOP(OP_SETPRIORITY,XTERM);
+ case KEY_umask:
+ UNIDOR(OP_UMASK);
- case KEY_sethostent:
- UNI(OP_SHOSTENT);
+ case KEY_unshift:
+ LOP(OP_UNSHIFT,XTERM);
- case KEY_setnetent:
- UNI(OP_SNETENT);
+ case KEY_use:
+ s = tokenize_use(1, s);
+ TOKEN(USE);
- case KEY_setservent:
- UNI(OP_SSERVENT);
+ case KEY_values:
+ UNI(OP_VALUES);
- case KEY_setprotoent:
- UNI(OP_SPROTOENT);
+ case KEY_vec:
+ LOP(OP_VEC,XTERM);
- case KEY_setpwent:
- FUN0(OP_SPWENT);
+ case KEY_when:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ return REPORT(0);
+ pl_yylval.ival = CopLINE(PL_curcop);
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
+ "when is experimental");
+ OPERATOR(WHEN);
- case KEY_setgrent:
- FUN0(OP_SGRENT);
+ case KEY_while:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ return REPORT(0);
+ pl_yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(WHILE);
- case KEY_seekdir:
- LOP(OP_SEEKDIR,XTERM);
+ case KEY_warn:
+ PL_hints |= HINT_BLOCK_SCOPE;
+ LOP(OP_WARN,XTERM);
- case KEY_setsockopt:
- LOP(OP_SSOCKOPT,XTERM);
+ case KEY_wait:
+ FUN0(OP_WAIT);
- case KEY_shift:
- UNIDOR(OP_SHIFT);
+ case KEY_waitpid:
+ LOP(OP_WAITPID,XTERM);
- case KEY_shmctl:
- LOP(OP_SHMCTL,XTERM);
+ case KEY_wantarray:
+ FUN0(OP_WANTARRAY);
- case KEY_shmget:
- LOP(OP_SHMGET,XTERM);
+ case KEY_write:
+ /* Make sure $^L is defined. 0x0C is CTRL-L on ASCII platforms, and
+ * we use the same number on EBCDIC */
+ gv_fetchpvs("\x0C", GV_ADD|GV_NOTQUAL, SVt_PV);
+ UNI(OP_ENTERWRITE);
- case KEY_shmread:
- LOP(OP_SHMREAD,XTERM);
+ case KEY_x:
+ if (PL_expect == XOPERATOR) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
+ return REPORT(0);
+ }
+ Mop(OP_REPEAT);
+ }
+ check_uni();
+ return yyl_just_a_word(aTHX_ s, len, orig_keyword, c);
- case KEY_shmwrite:
- LOP(OP_SHMWRITE,XTERM);
+ case KEY_xor:
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
+ return REPORT(0);
+ pl_yylval.ival = OP_XOR;
+ OPERATOR(OROP);
+ }
+}
- case KEY_shutdown:
- LOP(OP_SHUTDOWN,XTERM);
+static int
+yyl_key_core(pTHX_ char *s, STRLEN len, struct code c)
+{
+ I32 key = 0;
+ I32 orig_keyword = 0;
+ STRLEN olen = len;
+ char *d = s;
+ s += 2;
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+ if ((*s == ':' && s[1] == ':')
+ || (!(key = keyword(PL_tokenbuf, len, 1)) && *s == '\''))
+ {
+ Copy(PL_bufptr, PL_tokenbuf, olen, char);
+ return yyl_just_a_word(aTHX_ d, olen, 0, c);
+ }
+ if (!key)
+ Perl_croak(aTHX_ "CORE::%" UTF8f " is not a keyword",
+ UTF8fARG(UTF, len, PL_tokenbuf));
+ if (key < 0)
+ key = -key;
+ else if (key == KEY_require || key == KEY_do
+ || key == KEY_glob)
+ /* that's a way to remember we saw "CORE::" */
+ orig_keyword = key;
- case KEY_sin:
- UNI(OP_SIN);
+ /* Known to be a reserved word at this point */
+ return yyl_word_or_keyword(aTHX_ s, len, key, orig_keyword, c);
+}
- case KEY_sleep:
- UNI(OP_SLEEP);
+static int
+yyl_keylookup(pTHX_ char *s, GV *gv)
+{
+ dVAR;
+ STRLEN len;
+ bool anydelim;
+ I32 key;
+ struct code c = no_code;
+ I32 orig_keyword = 0;
+ char *d;
- case KEY_socket:
- LOP(OP_SOCKET,XTERM);
+ c.gv = gv;
- case KEY_socketpair:
- LOP(OP_SOCKPAIR,XTERM);
+ PL_bufptr = s;
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
- case KEY_sort:
- checkcomma(s,PL_tokenbuf,"subroutine name");
- s = skipspace(s);
- PL_expect = XTERM;
- s = force_word(s,BAREWORD,TRUE,TRUE);
- LOP(OP_SORT,XREF);
+ /* Some keywords can be followed by any delimiter, including ':' */
+ anydelim = word_takes_any_delimiter(PL_tokenbuf, len);
- case KEY_split:
- LOP(OP_SPLIT,XTERM);
+ /* x::* is just a word, unless x is "CORE" */
+ if (!anydelim && *s == ':' && s[1] == ':') {
+ if (memEQs(PL_tokenbuf, len, "CORE"))
+ return yyl_key_core(aTHX_ s, len, c);
+ return yyl_just_a_word(aTHX_ s, len, 0, c);
+ }
- case KEY_sprintf:
- LOP(OP_SPRINTF,XTERM);
+ d = s;
+ while (d < PL_bufend && isSPACE(*d))
+ d++; /* no comments skipped here, or s### is misparsed */
- case KEY_splice:
- LOP(OP_SPLICE,XTERM);
+ /* Is this a word before a => operator? */
+ if (*d == '=' && d[1] == '>') {
+ return yyl_fatcomma(aTHX_ s, len);
+ }
- case KEY_sqrt:
- UNI(OP_SQRT);
+ /* Check for plugged-in keyword */
+ {
+ OP *o;
+ int result;
+ char *saved_bufptr = PL_bufptr;
+ PL_bufptr = s;
+ result = PL_keyword_plugin(aTHX_ PL_tokenbuf, len, &o);
+ s = PL_bufptr;
+ if (result == KEYWORD_PLUGIN_DECLINE) {
+ /* not a plugged-in keyword */
+ PL_bufptr = saved_bufptr;
+ } else if (result == KEYWORD_PLUGIN_STMT) {
+ pl_yylval.opval = o;
+ CLINE;
+ if (!PL_nexttoke) PL_expect = XSTATE;
+ return REPORT(PLUGSTMT);
+ } else if (result == KEYWORD_PLUGIN_EXPR) {
+ pl_yylval.opval = o;
+ CLINE;
+ if (!PL_nexttoke) PL_expect = XOPERATOR;
+ return REPORT(PLUGEXPR);
+ } else {
+ Perl_croak(aTHX_ "Bad plugin affecting keyword '%s'", PL_tokenbuf);
+ }
+ }
- case KEY_srand:
- UNI(OP_SRAND);
+ /* Is this a label? */
+ if (!anydelim && PL_expect == XSTATE
+ && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
+ s = d + 1;
+ pl_yylval.opval =
+ newSVOP(OP_CONST, 0,
+ newSVpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0));
+ CLINE;
+ TOKEN(LABEL);
+ }
- case KEY_stat:
- UNI(OP_STAT);
+ /* Check for lexical sub */
+ if (PL_expect != XOPERATOR) {
+ char tmpbuf[sizeof PL_tokenbuf + 1];
+ *tmpbuf = '&';
+ Copy(PL_tokenbuf, tmpbuf+1, len, char);
+ c.off = pad_findmy_pvn(tmpbuf, len+1, 0);
+ if (c.off != NOT_IN_PAD) {
+ assert(c.off); /* we assume this is boolean-true below */
+ if (PAD_COMPNAME_FLAGS_isOUR(c.off)) {
+ HV * const stash = PAD_COMPNAME_OURSTASH(c.off);
+ HEK * const stashname = HvNAME_HEK(stash);
+ c.sv = newSVhek(stashname);
+ sv_catpvs(c.sv, "::");
+ sv_catpvn_flags(c.sv, PL_tokenbuf, len,
+ (UTF ? SV_CATUTF8 : SV_CATBYTES));
+ c.gv = gv_fetchsv(c.sv, GV_NOADD_NOINIT | SvUTF8(c.sv),
+ SVt_PVCV);
+ c.off = 0;
+ if (!c.gv) {
+ sv_free(c.sv);
+ c.sv = NULL;
+ return yyl_just_a_word(aTHX_ s, len, 0, c);
+ }
+ }
+ else {
+ c.rv2cv_op = newOP(OP_PADANY, 0);
+ c.rv2cv_op->op_targ = c.off;
+ c.cv = find_lexical_cv(c.off);
+ }
+ c.lex = TRUE;
+ return yyl_just_a_word(aTHX_ s, len, 0, c);
+ }
+ c.off = 0;
+ }
+
+ /* Check for built-in keyword */
+ key = keyword(PL_tokenbuf, len, 0);
+
+ if (key < 0)
+ key = yyl_secondclass_keyword(aTHX_ s, len, key, &orig_keyword, &c.gv, &c.gvp);
+
+ if (key && key != KEY___DATA__ && key != KEY___END__
+ && (!anydelim || *s != '#')) {
+ /* no override, and not s### either; skipspace is safe here
+ * check for => on following line */
+ bool arrow;
+ STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr);
+ STRLEN soff = s - SvPVX(PL_linestr);
+ s = peekspace(s);
+ arrow = *s == '=' && s[1] == '>';
+ PL_bufptr = SvPVX(PL_linestr) + bufoff;
+ s = SvPVX(PL_linestr) + soff;
+ if (arrow)
+ return yyl_fatcomma(aTHX_ s, len);
+ }
- case KEY_study:
- UNI(OP_STUDY);
+ return yyl_word_or_keyword(aTHX_ s, len, key, orig_keyword, c);
+}
- case KEY_substr:
- LOP(OP_SUBSTR,XTERM);
+static int
+yyl_try(pTHX_ char *s, STRLEN len)
+{
+ char *d;
+ GV *gv = NULL;
- case KEY_format:
- case KEY_sub:
- really_sub:
- return yyl_sub(aTHX_ s, tmp);
+ retry:
+ switch (*s) {
+ default:
+ if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s))
+ return yyl_keylookup(aTHX_ s, gv);
+ yyl_croak_unrecognised(aTHX_ s);
- case KEY_system:
- LOP(OP_SYSTEM,XREF);
+ case 4:
+ case 26:
+ /* emulate EOF on ^D or ^Z */
+ return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len);
- case KEY_symlink:
- LOP(OP_SYMLINK,XTERM);
+ case 0:
+ if ((!PL_rsfp || PL_lex_inwhat)
+ && (!PL_parser->filtered || s+1 < PL_bufend)) {
+ PL_last_uni = 0;
+ PL_last_lop = 0;
+ if (PL_lex_brackets
+ && PL_lex_brackstack[PL_lex_brackets-1] != XFAKEEOF)
+ {
+ yyerror((const char *)
+ (PL_lex_formbrack
+ ? "Format not terminated"
+ : "Missing right curly or square bracket"));
+ }
+ DEBUG_T({
+ PerlIO_printf(Perl_debug_log, "### Tokener got EOF\n");
+ });
+ TOKEN(0);
+ }
+ if (s++ < PL_bufend)
+ goto retry; /* ignore stray nulls */
+ PL_last_uni = 0;
+ PL_last_lop = 0;
+ if (!PL_in_eval && !PL_preambled) {
+ PL_preambled = TRUE;
+ if (PL_perldb) {
+ /* Generate a string of Perl code to load the debugger.
+ * If PERL5DB is set, it will return the contents of that,
+ * otherwise a compile-time require of perl5db.pl. */
- case KEY_syscall:
- LOP(OP_SYSCALL,XTERM);
+ const char * const pdb = PerlEnv_getenv("PERL5DB");
- case KEY_sysopen:
- LOP(OP_SYSOPEN,XTERM);
+ if (pdb) {
+ sv_setpv(PL_linestr, pdb);
+ sv_catpvs(PL_linestr,";");
+ } else {
+ SETERRNO(0,SS_NORMAL);
+ sv_setpvs(PL_linestr, "BEGIN { require 'perl5db.pl' };");
+ }
+ PL_parser->preambling = CopLINE(PL_curcop);
+ } else
+ SvPVCLEAR(PL_linestr);
+ if (PL_preambleav) {
+ SV **svp = AvARRAY(PL_preambleav);
+ SV **const end = svp + AvFILLp(PL_preambleav);
+ while(svp <= end) {
+ sv_catsv(PL_linestr, *svp);
+ ++svp;
+ sv_catpvs(PL_linestr, ";");
+ }
+ sv_free(MUTABLE_SV(PL_preambleav));
+ PL_preambleav = NULL;
+ }
+ if (PL_minus_E)
+ sv_catpvs(PL_linestr,
+ "use feature ':5." STRINGIFY(PERL_VERSION) "';");
+ if (PL_minus_n || PL_minus_p) {
+ sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
+ if (PL_minus_l)
+ sv_catpvs(PL_linestr,"chomp;");
+ if (PL_minus_a) {
+ if (PL_minus_F) {
+ if ( ( *PL_splitstr == '/'
+ || *PL_splitstr == '\''
+ || *PL_splitstr == '"')
+ && strchr(PL_splitstr + 1, *PL_splitstr))
+ {
+ /* strchr is ok, because -F pattern can't contain
+ * embeddded NULs */
+ Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s);", PL_splitstr);
+ }
+ else {
+ /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
+ bytes can be used as quoting characters. :-) */
+ const char *splits = PL_splitstr;
+ sv_catpvs(PL_linestr, "our @F=split(q\0");
+ do {
+ /* Need to \ \s */
+ if (*splits == '\\')
+ sv_catpvn(PL_linestr, splits, 1);
+ sv_catpvn(PL_linestr, splits, 1);
+ } while (*splits++);
+ /* This loop will embed the trailing NUL of
+ PL_linestr as the last thing it does before
+ terminating. */
+ sv_catpvs(PL_linestr, ");");
+ }
+ }
+ else
+ sv_catpvs(PL_linestr,"our @F=split(' ');");
+ }
+ }
+ 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 = NULL;
+ if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash)
+ update_debugger_info(PL_linestr, NULL, 0);
+ goto retry;
+ }
+ return yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s, len);
- case KEY_sysseek:
- LOP(OP_SYSSEEK,XTERM);
+ case '\r':
+#ifdef PERL_STRICT_CR
+ Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
+ Perl_croak(aTHX_
+ "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
+#endif
+ case ' ': case '\t': case '\f': case '\v':
+ s++;
+ goto retry;
- case KEY_sysread:
- LOP(OP_SYSREAD,XTERM);
+ case '#':
+ case '\n': {
+ const bool needs_semicolon = yyl_eol_needs_semicolon(aTHX_ &s);
+ if (needs_semicolon)
+ TOKEN(';');
+ else
+ goto retry;
+ }
- case KEY_syswrite:
- LOP(OP_SYSWRITE,XTERM);
+ case '-':
+ return yyl_hyphen(aTHX_ s);
- case KEY_tr:
- case KEY_y:
- s = scan_trans(s);
- TERM(sublex_start());
+ case '+':
+ return yyl_plus(aTHX_ s);
- case KEY_tell:
- UNI(OP_TELL);
+ case '*':
+ return yyl_star(aTHX_ s);
- case KEY_telldir:
- UNI(OP_TELLDIR);
+ case '%':
+ return yyl_percent(aTHX_ s);
- case KEY_tie:
- LOP(OP_TIE,XTERM);
+ case '^':
+ return yyl_caret(aTHX_ s);
- case KEY_tied:
- UNI(OP_TIED);
+ case '[':
+ return yyl_leftsquare(aTHX_ s);
- case KEY_time:
- FUN0(OP_TIME);
+ case '~':
+ return yyl_tilde(aTHX_ s);
- case KEY_times:
- FUN0(OP_TMS);
+ case ',':
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
+ TOKEN(0);
+ s++;
+ OPERATOR(',');
+ case ':':
+ if (s[1] == ':')
+ return yyl_just_a_word(aTHX_ s, 0, 0, no_code);
+ return yyl_colon(aTHX_ s + 1);
- case KEY_truncate:
- LOP(OP_TRUNCATE,XTERM);
+ case '(':
+ return yyl_leftparen(aTHX_ s + 1);
- case KEY_uc:
- UNI(OP_UC);
+ case ';':
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
+ TOKEN(0);
+ CLINE;
+ s++;
+ PL_expect = XSTATE;
+ TOKEN(';');
- case KEY_ucfirst:
- UNI(OP_UCFIRST);
+ case ')':
+ return yyl_rightparen(aTHX_ s);
- case KEY_untie:
- UNI(OP_UNTIE);
+ case ']':
+ return yyl_rightsquare(aTHX_ s);
- case KEY_until:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- return REPORT(0);
- pl_yylval.ival = CopLINE(PL_curcop);
- OPERATOR(UNTIL);
+ case '{':
+ return yyl_leftcurly(aTHX_ s + 1, 0);
- case KEY_unless:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- return REPORT(0);
- pl_yylval.ival = CopLINE(PL_curcop);
- OPERATOR(UNLESS);
+ case '}':
+ if (PL_lex_brackets && PL_lex_brackstack[PL_lex_brackets-1] == XFAKEEOF)
+ TOKEN(0);
+ return yyl_rightcurly(aTHX_ s, 0);
- case KEY_unlink:
- LOP(OP_UNLINK,XTERM);
+ case '&':
+ return yyl_ampersand(aTHX_ s);
- case KEY_undef:
- UNIDOR(OP_UNDEF);
+ case '|':
+ return yyl_verticalbar(aTHX_ s);
- case KEY_unpack:
- LOP(OP_UNPACK,XTERM);
+ case '=':
+ if (s[1] == '=' && (s == PL_linestart || s[-1] == '\n')
+ && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), "====="))
+ {
+ s = vcs_conflict_marker(s + 7);
+ goto retry;
+ }
- case KEY_utime:
- LOP(OP_UTIME,XTERM);
+ s++;
+ {
+ const char tmp = *s++;
+ if (tmp == '=') {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
+ s -= 2;
+ TOKEN(0);
+ }
+ Eop(OP_EQ);
+ }
+ if (tmp == '>') {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
+ {
+ s -= 2;
+ TOKEN(0);
+ }
+ 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 && !PL_parser->filtered)
+ || PL_lex_state != LEX_NORMAL)
+ {
+ d = PL_bufend;
+ while (s < d) {
+ if (*s++ == '\n') {
+ incline(s, PL_bufend);
+ if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=cut"))
+ {
+ s = (char *) memchr(s,'\n', d - s);
+ if (s)
+ s++;
+ else
+ s = d;
+ incline(s, PL_bufend);
+ goto retry;
+ }
+ }
+ }
+ goto retry;
+ }
+ s = PL_bufend;
+ PL_parser->in_pod = 1;
+ goto retry;
+ }
+ }
+ if (PL_expect == XBLOCK) {
+ const char *t = s;
+#ifdef PERL_STRICT_CR
+ while (SPACE_OR_TAB(*t))
+#else
+ while (SPACE_OR_TAB(*t) || *t == '\r')
+#endif
+ t++;
+ if (*t == '\n' || *t == '#') {
+ ENTER_with_name("lex_format");
+ SAVEI8(PL_parser->form_lex_state);
+ SAVEI32(PL_lex_formbrack);
+ PL_parser->form_lex_state = PL_lex_state;
+ PL_lex_formbrack = PL_lex_brackets + 1;
+ PL_parser->sub_error_count = PL_error_count;
+ return yyl_leftcurly(aTHX_ s, 1);
+ }
+ }
+ if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ s--;
+ TOKEN(0);
+ }
+ pl_yylval.ival = 0;
+ OPERATOR(ASSIGNOP);
- case KEY_umask:
- UNIDOR(OP_UMASK);
+ case '!':
+ return yyl_bang(aTHX_ s + 1);
- case KEY_unshift:
- LOP(OP_UNSHIFT,XTERM);
+ case '<':
+ if (s[1] == '<' && (s == PL_linestart || s[-1] == '\n')
+ && memBEGINs(s+2, (STRLEN) (PL_bufend - (s+2)), "<<<<<"))
+ {
+ s = vcs_conflict_marker(s + 7);
+ goto retry;
+ }
+ return yyl_leftpointy(aTHX_ s);
- case KEY_use:
- s = tokenize_use(1, s);
- TOKEN(USE);
+ case '>':
+ if (s[1] == '>' && (s == PL_linestart || s[-1] == '\n')
+ && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), ">>>>>"))
+ {
+ s = vcs_conflict_marker(s + 7);
+ goto retry;
+ }
+ return yyl_rightpointy(aTHX_ s + 1);
- case KEY_values:
- UNI(OP_VALUES);
+ case '$':
+ return yyl_dollar(aTHX_ s);
- case KEY_vec:
- LOP(OP_VEC,XTERM);
+ case '@':
+ return yyl_snail(aTHX_ s);
- case KEY_when:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- return REPORT(0);
- pl_yylval.ival = CopLINE(PL_curcop);
- Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
- "when is experimental");
- OPERATOR(WHEN);
+ case '/': /* may be division, defined-or, or pattern */
+ return yyl_slash(aTHX_ s);
- case KEY_while:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
- return REPORT(0);
- pl_yylval.ival = CopLINE(PL_curcop);
- OPERATOR(WHILE);
+ case '?': /* conditional */
+ s++;
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_IFELSE)
+ {
+ s--;
+ TOKEN(0);
+ }
+ PL_lex_allbrackets++;
+ OPERATOR('?');
- case KEY_warn:
- PL_hints |= HINT_BLOCK_SCOPE;
- LOP(OP_WARN,XTERM);
+ case '.':
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
+#ifdef PERL_STRICT_CR
+ && s[1] == '\n'
+#else
+ && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
+#endif
+ && (s == PL_linestart || s[-1] == '\n') )
+ {
+ PL_expect = XSTATE;
+ /* formbrack==2 means dot seen where arguments expected */
+ return yyl_rightcurly(aTHX_ s, 2);
+ }
+ if (PL_expect == XSTATE && s[1] == '.' && s[2] == '.') {
+ s += 3;
+ OPERATOR(YADAYADA);
+ }
+ if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
+ char tmp = *s++;
+ if (*s == tmp) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_RANGE)
+ {
+ s--;
+ TOKEN(0);
+ }
+ s++;
+ if (*s == tmp) {
+ s++;
+ pl_yylval.ival = OPf_SPECIAL;
+ }
+ else
+ pl_yylval.ival = 0;
+ OPERATOR(DOTDOT);
+ }
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
+ s--;
+ TOKEN(0);
+ }
+ Aop(OP_CONCAT);
+ }
+ /* FALLTHROUGH */
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ s = scan_num(s, &pl_yylval);
+ DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
+ if (PL_expect == XOPERATOR)
+ no_op("Number",s);
+ TERM(THING);
- case KEY_wait:
- FUN0(OP_WAIT);
+ case '\'':
+ return yyl_sglquote(aTHX_ s);
- case KEY_waitpid:
- LOP(OP_WAITPID,XTERM);
+ case '"':
+ return yyl_dblquote(aTHX_ s, len);
- case KEY_wantarray:
- FUN0(OP_WANTARRAY);
+ case '`':
+ return yyl_backtick(aTHX_ s);
- case KEY_write:
- /* Make sure $^L is defined. 0x0C is CTRL-L on ASCII platforms, and
- * we use the same number on EBCDIC */
- gv_fetchpvs("\x0C", GV_ADD|GV_NOTQUAL, SVt_PV);
- UNI(OP_ENTERWRITE);
+ case '\\':
+ return yyl_backslash(aTHX_ s + 1);
- case KEY_x:
- if (PL_expect == XOPERATOR) {
- if (*s == '=' && !PL_lex_allbrackets
- && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
- {
- return REPORT(0);
- }
- Mop(OP_REPEAT);
+ case 'v':
+ if (isDIGIT(s[1]) && PL_expect != XOPERATOR) {
+ char *start = s + 2;
+ while (isDIGIT(*start) || *start == '_')
+ start++;
+ if (*start == '.' && isDIGIT(start[1])) {
+ s = scan_num(s, &pl_yylval);
+ TERM(THING);
+ }
+ else if ((*start == ':' && start[1] == ':')
+ || (PL_expect == XSTATE && *start == ':'))
+ return yyl_keylookup(aTHX_ s, gv);
+ else if (PL_expect == XSTATE) {
+ d = start;
+ while (d < PL_bufend && isSPACE(*d)) d++;
+ if (*d == ':')
+ return yyl_keylookup(aTHX_ s, gv);
+ }
+ /* avoid v123abc() or $h{v1}, allow C<print v10;> */
+ if (!isALPHA(*start) && (PL_expect == XTERM
+ || PL_expect == XREF || PL_expect == XSTATE
+ || PL_expect == XTERMORDORDOR)) {
+ GV *const gv = gv_fetchpvn_flags(s, start - s,
+ UTF ? SVf_UTF8 : 0, SVt_PVCV);
+ if (!gv) {
+ s = scan_num(s, &pl_yylval);
+ TERM(THING);
+ }
}
- check_uni();
- goto just_a_word;
+ }
+ return yyl_keylookup(aTHX_ s, gv);
- case KEY_xor:
- if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_LOWLOGIC)
- return REPORT(0);
- pl_yylval.ival = OP_XOR;
- OPERATOR(OROP);
+ case 'x':
+ if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
+ s++;
+ Mop(OP_REPEAT);
}
- }}
+ return yyl_keylookup(aTHX_ s, gv);
+
+ case '_':
+ case 'a': case 'A':
+ case 'b': case 'B':
+ case 'c': case 'C':
+ case 'd': case 'D':
+ case 'e': case 'E':
+ case 'f': case 'F':
+ case 'g': case 'G':
+ case 'h': case 'H':
+ case 'i': case 'I':
+ case 'j': case 'J':
+ case 'k': case 'K':
+ case 'l': case 'L':
+ case 'm': case 'M':
+ case 'n': case 'N':
+ case 'o': case 'O':
+ case 'p': case 'P':
+ case 'q': case 'Q':
+ case 'r': case 'R':
+ case 's': case 'S':
+ case 't': case 'T':
+ case 'u': case 'U':
+ case 'V':
+ case 'w': case 'W':
+ case 'X':
+ case 'y': case 'Y':
+ case 'z': case 'Z':
+ return yyl_keylookup(aTHX_ s, gv);
+ }
}
scan built-in keyword (but do nothing with it yet)
check for statement label
check for lexical subs
- goto just_a_word if there is one
+ return yyl_just_a_word if there is one
see whether built-in keyword is overridden
switch on keyword number:
- - default: just_a_word:
+ - default: return yyl_just_a_word:
not a built-in keyword; handle bareword lookup
disambiguate between method and sub call
fall back to bareword
{
dVAR;
char *s = PL_bufptr;
- const bool saw_infix_sigil = cBOOL(PL_parser->saw_infix_sigil);
if (UNLIKELY(PL_parser->recheck_utf8_validity)) {
const U8* first_bad_char_loc;
}
assert(PL_lex_formbrack);
s = scan_formline(PL_bufptr);
- if (!PL_lex_formbrack) {
- return yyl_try(aTHX_ '}', s, 0, 0, NULL, NULL, 1, 0, saw_infix_sigil);
- }
+ if (!PL_lex_formbrack)
+ return yyl_rightcurly(aTHX_ s, 1);
PL_bufptr = s;
return yylex();
}
s = PL_bufptr;
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
- PL_parser->saw_infix_sigil = 0;
if (PL_in_my == KEY_sigvar) {
+ PL_parser->saw_infix_sigil = 0;
return yyl_sigvar(aTHX_ s);
}
- return yyl_try(aTHX_ 0, s, 0, 0, NULL, NULL, 0, 0, saw_infix_sigil);
+ {
+ /* yyl_try() and its callees might consult PL_parser->saw_infix_sigil.
+ On its return, we then need to set it to indicate whether the token
+ we just encountered was an infix operator that (if we hadn't been
+ expecting an operator) have been a sigil.
+ */
+ bool expected_operator = (PL_expect == XOPERATOR);
+ int ret = yyl_try(aTHX_ s, 0);
+ switch (pl_yylval.ival) {
+ case OP_BIT_AND:
+ case OP_MODULO:
+ case OP_MULTIPLY:
+ case OP_NBIT_AND:
+ if (expected_operator) {
+ PL_parser->saw_infix_sigil = 1;
+ break;
+ }
+ /* FALLTHROUGH */
+ default:
+ PL_parser->saw_infix_sigil = 0;
+ }
+ return ret;
+ }
}
}
if (UNLIKELY(tick_warn && saw_tick && PL_lex_state == LEX_INTERPNORMAL
&& !PL_lex_brackets && ckWARN(WARN_SYNTAX))) {
- char *d;
+ char *this_d;
char *d2;
- Newx(d, *s - olds + saw_tick + 2, char); /* +2 for $# */
- d2 = d;
- SAVEFREEPV(d);
+ Newx(this_d, *s - olds + saw_tick + 2, char); /* +2 for $# */
+ d2 = this_d;
+ SAVEFREEPV(this_d);
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Old package separator used in string");
if (olds[-1] == '#')
}
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\t(Did you mean \"%" UTF8f "\" instead?)\n",
- UTF8fARG(is_utf8, d2-d, d));
+ UTF8fARG(is_utf8, d2-this_d, this_d));
}
return;
}
o = newPVOP(nondestruct ? OP_TRANSR : OP_TRANS, 0, (char*)NULL);
o->op_private &= ~OPpTRANS_ALL;
- o->op_private |= del|squash|complement|
- (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
- (DO_UTF8(PL_parser->lex_sub_repl) ? OPpTRANS_TO_UTF : 0);
+ o->op_private |= del|squash|complement;
PL_lex_op = o;
pl_yylval.ival = nondestruct ? OP_TRANSR : OP_TRANS;
https://perl5.git.perl.org / perl5.git / blobdiff