* 1999-02-27 mjd-perl-patch@plover.com */
#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
-#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
+#define SPACE_OR_TAB(c) isBLANK_A(c)
/* LEX_* are values for PL_lex_state, the state of the lexer.
* They are arranged oddly so that the guard on the switch statement
SAVEGENERICPV(PL_lex_brackstack);
SAVEGENERICPV(PL_lex_casestack);
SAVEGENERICPV(PL_parser->lex_shared);
+ SAVEBOOL(PL_parser->lex_re_reparsing);
/* The here-doc parser needs to be able to peek into outer lexing
scopes to find the body of the here-doc. So we put PL_linestr and
else
PL_lex_inpat = NULL;
+ PL_parser->lex_re_reparsing = cBOOL(PL_in_eval & EVAL_RE_REPARSING);
+ PL_in_eval &= ~EVAL_RE_REPARSING;
+
return '(';
}
if (! isCHARNAME_CONT(*s)) {
goto bad_charname;
}
- if (*s == ' ' && *(s-1) == ' ' && ckWARN(WARN_DEPRECATED)) {
+ if (*s == ' ' && *(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
Perl_warn(aTHX_ "A sequence of multiple spaces in a charnames alias definition is deprecated");
}
s++;
}
- if (*(s-1) == ' ' && ckWARN(WARN_DEPRECATED)) {
+ if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
Perl_warn(aTHX_ "Trailing white-space in a charnames alias definition is deprecated");
}
}
if (! isCHARNAME_CONT(*s)) {
goto bad_charname;
}
- if (*s == ' ' && *(s-1) == ' ' && ckWARN(WARN_DEPRECATED)) {
+ if (*s == ' ' && *(s-1) == ' '
+ && ckWARN_d(WARN_DEPRECATED)) {
Perl_warn(aTHX_ "A sequence of multiple spaces in a charnames alias definition is deprecated");
}
s++;
s += UTF8SKIP(s);
}
}
- if (*(s-1) == ' ' && ckWARN(WARN_DEPRECATED)) {
+ if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
Perl_warn(aTHX_ "Trailing white-space in a charnames alias definition is deprecated");
}
}
/* return the substring (via pl_yylval) only if we parsed anything */
if (s > PL_bufptr) {
SvREFCNT_inc_simple_void_NN(sv);
- if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
+ if ( (PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ))
+ && ! PL_parser->lex_re_reparsing)
+ {
const char *const key = PL_lex_inpat ? "qr" : "q";
const STRLEN keylen = PL_lex_inpat ? 2 : 1;
const char *type;
return 0;
}
}
- s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
- /* start is the beginning of the possible filehandle/object,
- * and s is the end of it
- * tmpbuf is a copy of it
- */
if (*start == '$') {
if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
PL_expect = XREF;
return *s == '(' ? FUNCMETH : METHOD;
}
+
+ s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
+ /* start is the beginning of the possible filehandle/object,
+ * and s is the end of it
+ * tmpbuf is a copy of it (but with single quotes as double colons)
+ */
+
if (!keyword(tmpbuf, len, 0)) {
if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
len -= 2;
DEBUG_T({ if(*PL_bufptr != '(') PerlIO_printf(Perl_debug_log,
"### Interpolated variable\n"); });
PL_expect = XTERM;
- PL_lex_dojoin = (*PL_bufptr == '@');
+ /* for /@a/, we leave the joining for the regex engine to do
+ * (unless we're within \Q etc) */
+ PL_lex_dojoin = (*PL_bufptr == '@'
+ && (!PL_lex_inpat || PL_lex_casemods));
PL_lex_state = LEX_INTERPNORMAL;
if (PL_lex_dojoin) {
start_force(PL_curforce);
#ifdef PERL_MAD
PL_thistoken = subtoken;
s = d;
+ PERL_UNUSED_VAR(tboffset);
#else
if (have_name)
(void) force_word(PL_oldbufptr + tboffset, WORD,
force_next(0);
PL_thistoken = subtoken;
+ PERL_UNUSED_VAR(have_proto);
#else
if (have_proto) {
NEXTVAL_NEXTTOKE.opval =
*d = '\0';
d = dest;
if (*d) {
+ /* Either a digit variable, or parse_ident() found an identifier
+ (anything valid as a bareword), so job done and return. */
if (PL_lex_state != LEX_NORMAL)
PL_lex_state = LEX_INTERPENDMAYBE;
return s;
|| s[1] == '{'
|| strnEQ(s+1,"::",2)) )
{
+ /* Dereferencing a value in a scalar variable.
+ The alternatives are different syntaxes for a scalar variable.
+ Using ' as a leading package separator isn't allowed. :: is. */
return s;
}
+ /* Handle the opening { of @{...}, &{...}, *{...}, %{...}, ${...} */
if (*s == '{') {
bracket = s;
s++;
s++;
}
-#define VALID_LEN_ONE_IDENT(d, u) (isPUNCT_A((U8)*(d)) \
- || isCNTRL_A((U8)*(d)) \
- || isDIGIT_A((U8)*(d)) \
- || (!(u) && !UTF8_IS_INVARIANT((U8)*(d))))
+#define VALID_LEN_ONE_IDENT(d, u) (isPUNCT_A((U8)(d)) \
+ || isCNTRL_A((U8)(d)) \
+ || isDIGIT_A((U8)(d)) \
+ || (!(u) && !UTF8_IS_INVARIANT((U8)(d))))
if (s < send
- && (isIDFIRST_lazy_if(s, is_utf8) || VALID_LEN_ONE_IDENT(s, is_utf8)))
+ && (isIDFIRST_lazy_if(s, is_utf8) || VALID_LEN_ONE_IDENT(*s, is_utf8)))
{
if (is_utf8) {
const STRLEN skip = UTF8SKIP(s);
d[1] = '\0';
}
}
+ /* Convert $^F, ${^F} and the ^F of ${^FOO} to control characters */
if (*d == '^' && *s && isCONTROLVAR(*s)) {
*d = toCTRL(*s);
s++;
}
+ /* Warn about ambiguous code after unary operators if {...} notation isn't
+ used. There's no difference in ambiguity; it's merely a heuristic
+ about when not to warn. */
else if (ck_uni && !bracket)
check_uni();
if (bracket) {
+ /* If we were processing {...} notation then... */
if (isIDFIRST_lazy_if(d,is_utf8)) {
+ /* if it starts as a valid identifier, assume that it is one.
+ (the later check for } being at the expected point will trap
+ cases where this doesn't pan out.) */
d += is_utf8 ? UTF8SKIP(d) : 1;
parse_ident(&s, &d, e, 1, is_utf8);
*d = '\0';
while (s < send && SPACE_OR_TAB(*s))
s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
+ /* ${foo[0]} and ${foo{bar}} notation. */
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
const char * const brack =
(const char *)
}
/* Handle extended ${^Foo} variables
* 1999-02-27 mjd-perl-patch@plover.com */
- else if (!isWORDCHAR(*d) && !isPRINT(*d) /* isCTRL(d) */
+ else if (! isPRINT(*d) /* isCNTRL(d), plus all non-ASCII */
&& isWORDCHAR(*s))
{
d++;
while (s < send && SPACE_OR_TAB(*s))
s++;
+ /* Expect to find a closing } after consuming any trailing whitespace.
+ */
if (*s == '}') {
s++;
if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
}
}
else {
+ /* Didn't find the closing } at the point we expected, so restore
+ state such that the next thing to process is the opening { and */
s = bracket; /* let the parser handle it */
*dest = '\0';
}
s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING),
TRUE /* look for escaped bracketed metas */ );
- /* this was only needed for the initial scan_str; set it to false
- * so that any (?{}) code blocks etc are parsed normally */
- PL_in_eval &= ~EVAL_RE_REPARSING;
if (!s) {
const char * const delimiter = skipspace(start);
Perl_croak(aTHX_
https://perl5.git.perl.org / perl5.git / blobdiff