#define BOop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITOROP))
#define BAop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITANDOP))
#define BCop(f) return pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr = s, \
- REPORT('~')
+ REPORT(PERLY_TILDE)
#define SHop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)SHIFTOP))
#define PWop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)POWOP))
#define PMop(f) return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
TOKENTYPE_OPVAL
};
+#define DEBUG_TOKEN(Type, Name) \
+ { Name, TOKENTYPE_##Type, #Name }
+
static struct debug_tokens {
const int token;
enum token_type type;
{ OROP, TOKENTYPE_IVAL, "OROP" },
{ OROR, TOKENTYPE_NONE, "OROR" },
{ PACKAGE, TOKENTYPE_NONE, "PACKAGE" },
+ DEBUG_TOKEN (IVAL, PERLY_AMPERSAND),
+ DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE),
+ DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN),
+ DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE),
+ DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN),
+ DEBUG_TOKEN (IVAL, PERLY_COLON),
+ DEBUG_TOKEN (IVAL, PERLY_COMMA),
+ DEBUG_TOKEN (IVAL, PERLY_DOT),
+ DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN),
+ DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK),
+ DEBUG_TOKEN (IVAL, PERLY_MINUS),
+ DEBUG_TOKEN (IVAL, PERLY_PAREN_OPEN),
+ DEBUG_TOKEN (IVAL, PERLY_PERCENT_SIGN),
+ DEBUG_TOKEN (IVAL, PERLY_PLUS),
+ DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK),
+ DEBUG_TOKEN (IVAL, PERLY_SEMICOLON),
+ DEBUG_TOKEN (IVAL, PERLY_SNAIL),
+ DEBUG_TOKEN (IVAL, PERLY_TILDE),
{ PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" },
{ PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" },
{ PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" },
{ 0, TOKENTYPE_NONE, NULL }
};
+#undef DEBUG_TOKEN
+
/* dump the returned token in rv, plus any optional arg in pl_yylval */
STATIC int
static int
S_postderef(pTHX_ int const funny, char const next)
{
- assert(funny == DOLSHARP || memCHRs("$@%&*", funny));
+ assert(funny == DOLSHARP
+ || memCHRs("$@%&*", funny)
+ || funny == PERLY_SNAIL
+ || funny == PERLY_PERCENT_SIGN
+ || funny == PERLY_AMPERSAND
+ );
if (next == '*') {
PL_expect = XOPERATOR;
if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
- assert('@' == funny || '$' == funny || DOLSHARP == funny);
+ assert(PERLY_SNAIL == funny || '$' == funny || DOLSHARP == funny);
PL_lex_state = LEX_INTERPEND;
- if ('@' == funny)
+ if (PERLY_SNAIL == funny)
force_next(POSTJOIN);
}
force_next(next);
PL_bufptr+=2;
}
else {
- if ('@' == funny && PL_lex_state == LEX_INTERPNORMAL
+ if (PERLY_SNAIL == funny && PL_lex_state == LEX_INTERPNORMAL
&& !PL_lex_brackets)
PL_lex_dojoin = 2;
PL_expect = XOPERATOR;
if (yyc != YYEMPTY) {
if (yyc) {
NEXTVAL_NEXTTOKE = PL_parser->yylval;
- if (yyc == '{'/*}*/ || yyc == HASHBRACK || yyc == '['/*]*/) {
+ if (yyc == PERLY_BRACE_OPEN || yyc == HASHBRACK || yyc == PERLY_BRACKET_OPEN) {
PL_lex_allbrackets--;
PL_lex_brackets--;
yyc |= (3<<24) | (PL_lex_brackstack[PL_lex_brackets] << 16);
- } else if (yyc == '('/*)*/) {
+ } else if (yyc == PERLY_PAREN_OPEN) {
PL_lex_allbrackets--;
yyc |= (2<<24);
}
(PL_in_eval ? GV_ADDMULTI
: GV_ADD) | ( UTF ? SVf_UTF8 : 0 ),
kind == '$' ? SVt_PV :
- kind == '@' ? SVt_PVAV :
- kind == '%' ? SVt_PVHV :
+ kind == PERLY_SNAIL ? SVt_PVAV :
+ kind == PERLY_PERCENT_SIGN ? SVt_PVHV :
SVt_PVGV
);
}
break;
}
- TOKEN(sigil);
+ switch (sigil) {
+ case ',': TOKEN (PERLY_COMMA);
+ case '@': TOKEN (PERLY_SNAIL);
+ case '%': TOKEN (PERLY_PERCENT_SIGN);
+ default: TOKEN (sigil);
+ }
}
static int
PL_lex_casestack[PL_lex_casemods] = '\0';
PL_lex_state = LEX_INTERPCONCAT;
NEXTVAL_NEXTTOKE.ival = 0;
- force_next((2<<24)|'(');
+ force_next((2<<24)|PERLY_PAREN_OPEN);
if (*s == 'l')
NEXTVAL_NEXTTOKE.ival = OP_LCFIRST;
else if (*s == 'u')
PL_lex_starts = 0;
/* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
if (PL_lex_casemods == 1 && PL_lex_inpat)
- TOKEN(',');
+ TOKEN(PERLY_COMMA);
else
AopNOASSIGN(OP_CONCAT);
}
if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=>")) {
s = force_word(PL_bufptr,BAREWORD,FALSE,FALSE);
DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
- OPERATOR('-'); /* unary minus */
+ OPERATOR(PERLY_MINUS); /* unary minus */
}
switch (tmp) {
case 'r': ftst = OP_FTEREAD; break;
else {
if (isSPACE(*s) || !isSPACE(*PL_bufptr))
check_uni();
- OPERATOR('-'); /* unary minus */
+ OPERATOR(PERLY_MINUS); /* unary minus */
}
}
}
else {
if (isSPACE(*s) || !isSPACE(*PL_bufptr))
check_uni();
- OPERATOR('+');
+ OPERATOR(PERLY_PLUS);
}
}
Mop(OP_MODULO);
}
else if (PL_expect == XPOSTDEREF)
- POSTDEREF('%');
+ POSTDEREF(PERLY_PERCENT_SIGN);
PL_tokenbuf[0] = '%';
s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
pl_yylval.ival = 0;
if (!PL_tokenbuf[1]) {
- PREREF('%');
+ PREREF(PERLY_PERCENT_SIGN);
}
if ( (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
&& intuit_more(s, PL_bufend)) {
}
PL_expect = XOPERATOR;
force_ident_maybe_lex('%');
- TERM('%');
+ TERM(PERLY_PERCENT_SIGN);
}
static int
: "Unterminated attribute list" ) );
if (attrs)
op_free(attrs);
- OPERATOR(':');
+ OPERATOR(PERLY_COLON);
}
got_attrs:
}
PL_lex_allbrackets--;
- OPERATOR(':');
+ OPERATOR(PERLY_COLON);
}
static int
const char minus = (PL_tokenbuf[0] == '-');
s = force_word(s + minus, BAREWORD, FALSE, TRUE);
if (minus)
- force_next('-');
+ force_next(PERLY_MINUS);
}
}
/* FALLTHROUGH */
pl_yylval.ival = CopLINE(PL_curcop);
PL_copline = NOLINE; /* invalidate current command line number */
- TOKEN(formbrack ? '=' : '{');
+ TOKEN(formbrack ? PERLY_EQUAL_SIGN : PERLY_BRACE_OPEN);
}
static int
return yylex(); /* ignore fake brackets */
}
- force_next(formbrack ? '.' : '}');
+ force_next(formbrack ? PERLY_DOT : PERLY_BRACE_CLOSE);
if (formbrack) LEAVE_with_name("lex_format");
if (formbrack == 2) { /* means . where arguments were expected */
- force_next(';');
+ force_next(PERLY_SEMICOLON);
TOKEN(FORMRBRACK);
}
- TOKEN(';');
+ TOKEN(PERLY_SEMICOLON);
}
static int
yyl_ampersand(pTHX_ char *s)
{
if (PL_expect == XPOSTDEREF)
- POSTDEREF('&');
+ POSTDEREF(PERLY_AMPERSAND);
s++;
if (*s++ == '&') {
if (PL_tokenbuf[1])
force_ident_maybe_lex('&');
else
- PREREF('&');
+ PREREF(PERLY_AMPERSAND);
- TERM('&');
+ TERM(PERLY_AMPERSAND);
}
static int
PMop(OP_NOT);
s--;
- OPERATOR('!');
+ OPERATOR(PERLY_EXCLAMATION_MARK);
}
static int
yyl_snail(pTHX_ char *s)
{
if (PL_expect == XPOSTDEREF)
- POSTDEREF('@');
+ POSTDEREF(PERLY_SNAIL);
PL_tokenbuf[0] = '@';
s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
if (PL_expect == XOPERATOR) {
}
pl_yylval.ival = 0;
if (!PL_tokenbuf[1]) {
- PREREF('@');
+ PREREF(PERLY_SNAIL);
}
if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
s = skipspace(s);
}
PL_expect = XOPERATOR;
force_ident_maybe_lex('@');
- TERM('@');
+ TERM(PERLY_SNAIL);
}
static int
static int
yyl_leftsquare(pTHX_ char *s)
{
- char tmp;
-
if (PL_lex_brackets > 100)
Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
PL_lex_brackstack[PL_lex_brackets++] = 0;
PL_lex_allbrackets++;
- tmp = *s++;
- OPERATOR(tmp);
+ s++;
+ OPERATOR(PERLY_BRACKET_OPEN);
}
static int
PL_lex_state = LEX_INTERPEND;
}
}
- TERM(']');
+ TERM(PERLY_BRACKET_CLOSE);
}
static int
PL_expect = XTERM;
s = skipspace(s);
PL_lex_allbrackets++;
- TOKEN('(');
+ TOKEN(PERLY_PAREN_OPEN);
}
static int
if (!lex_next_chunk(fake_eof)) {
CopLINE_dec(PL_curcop);
s = PL_bufptr;
- TOKEN(';'); /* not infinite loop because rsfp is NULL now */
+ TOKEN(PERLY_SEMICOLON); /* not infinite loop because rsfp is NULL now */
}
CopLINE_dec(PL_curcop);
s = PL_bufptr;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_lex_state = LEX_FORMLINE;
force_next(FORMRBRACK);
- TOKEN(';');
+ TOKEN(PERLY_SEMICOLON);
}
PL_bufptr = s;
op_free(pl_yylval.opval), force_next(PRIVATEREF);
else op_free(c.rv2cv_op), force_next(BAREWORD);
pl_yylval.ival = 0;
- TOKEN('&');
+ TOKEN(PERLY_AMPERSAND);
}
/* If followed by var or block, call it a method (unless sub) */
}
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)
case '\n': {
const bool needs_semicolon = yyl_eol_needs_semicolon(aTHX_ &s);
if (needs_semicolon)
- TOKEN(';');
+ TOKEN(PERLY_SEMICOLON);
else
goto retry;
}
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
TOKEN(0);
s++;
- OPERATOR(',');
+ OPERATOR(PERLY_COMMA);
case ':':
if (s[1] == ':')
return yyl_just_a_word(aTHX_ s, 0, 0, no_code);
CLINE;
s++;
PL_expect = XSTATE;
- TOKEN(';');
+ TOKEN(PERLY_SEMICOLON);
case ')':
return yyl_rightparen(aTHX_ s);
s -= 2;
TOKEN(0);
}
- OPERATOR(',');
+ OPERATOR(PERLY_COMMA);
}
if (tmp == '~')
PMop(OP_MATCH);
pl_yylval.ival = 0;
OPERATOR(ASSIGNOP);
- case '!':
+ case '!':
return yyl_bang(aTHX_ s + 1);
case '<':
TOKEN(0);
}
PL_lex_allbrackets++;
- OPERATOR('?');
+ OPERATOR(PERLY_QUESTION_MARK);
case '.':
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
PL_lex_state = LEX_INTERPNORMAL;
if (PL_lex_dojoin) {
NEXTVAL_NEXTTOKE.ival = 0;
- force_next(',');
+ force_next(PERLY_COMMA);
force_ident("\"", '$');
NEXTVAL_NEXTTOKE.ival = 0;
force_next('$');
NEXTVAL_NEXTTOKE.ival = 0;
- force_next((2<<24)|'(');
+ force_next((2<<24)|PERLY_PAREN_OPEN);
NEXTVAL_NEXTTOKE.ival = OP_JOIN; /* emulate join($", ...) */
force_next(FUNC);
}
s = PL_bufptr;
/* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
if (!PL_lex_casemods && PL_lex_inpat)
- TOKEN(',');
+ TOKEN(PERLY_COMMA);
else
AopNOASSIGN(OP_CONCAT);
}
force_next(THING);
PL_parser->lex_shared->re_eval_start = NULL;
PL_expect = XTERM;
- return REPORT(',');
+ return REPORT(PERLY_COMMA);
}
/* FALLTHROUGH */
if (PL_lex_starts++) {
/* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
if (!PL_lex_casemods && PL_lex_inpat)
- TOKEN(',');
+ TOKEN(PERLY_COMMA);
else
AopNOASSIGN(OP_CONCAT);
}
/* 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
\d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) 12 12.34 12.
\.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) .34
0b[01](_?[01])* binary integers
- 0[0-7](_?[0-7])* octal integers
+ 0o?[0-7](_?[0-7])* octal integers
0x[0-9A-Fa-f](_?[0-9A-Fa-f])* hexadecimal integers
0x[0-9A-Fa-f](_?[0-9A-Fa-f])*(?:\.\d*)?p[+-]?[0-9]+ hexadecimal floats
NV hexfp_mult = 1.0;
UV high_non_zero = 0; /* highest digit */
int non_zero_integer_digits = 0;
+ bool new_octal = FALSE; /* octal with "0o" prefix */
PERL_ARGS_ASSERT_SCAN_NUM;
"",
"037777777777",
"0xffffffff" };
- const char *base, *Base, *max;
/* check for hex */
if (isALPHA_FOLD_EQ(s[1], 'x')) {
else {
shift = 3;
s++;
+ if (isALPHA_FOLD_EQ(*s, 'o')) {
+ s++;
+ just_zero = FALSE;
+ new_octal = TRUE;
+ }
}
if (*s == '_') {
lastub = s++;
}
- base = bases[shift];
- Base = Bases[shift];
- max = maxima[shift];
-
/* read the rest of the number */
for (;;) {
/* x is used in the overflow test,
n = (NV) u;
Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in %s number",
- base);
+ bases[shift]);
} else
u = x | b; /* add the digit to the end */
}
}
}
- if (shift != 3 && !has_digs) {
- /* 0x or 0b with no digits, treat it as an error.
+ if (!just_zero && !has_digs) {
+ /* 0x, 0o or 0b with no digits, treat it as an error.
Originally this backed up the parse before the b or
x, but that has the potential for silent changes in
behaviour, like for: "0x.3" and "0x+$foo".
if (*d) ++d; /* so the user sees the bad non-digit */
PL_bufptr = (char *)d; /* so yyerror reports the context */
yyerror(Perl_form(aTHX_ "No digits found for %s literal",
- shift == 4 ? "hexadecimal" : "binary"));
+ bases[shift]));
PL_bufptr = oldbp;
}
if (n > 4294967295.0)
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
- Base, max);
+ Bases[shift],
+ new_octal ? "0o37777777777" : maxima[shift]);
sv = newSVnv(n);
}
else {
if (u > 0xffffffff)
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
- Base, max);
+ Bases[shift],
+ new_octal ? "0o37777777777" : maxima[shift]);
#endif
sv = newSVuv(u);
}
s = start + 2;
break;
case 3:
+ if (new_octal) {
+ *d++ = 'o';
+ s = start + 2;
+ break;
+ }
s = start + 1;
break;
case 1:
* processing unconditionally */
if (s != NULL) {
- if (!yychar || (yychar == ';' && !PL_rsfp))
+ if (!yychar || (yychar == PERLY_SEMICOLON && !PL_rsfp))
sv_catpvs(where_sv, "at EOF");
else if ( PL_oldoldbufptr
&& PL_bufptr > PL_oldoldbufptr
https://perl5.git.perl.org / perl5.git / blobdiff