#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
-# define SKIPSPACE0(s) skipspace(s)
-# define SKIPSPACE1(s) skipspace(s)
-# define SKIPSPACE2(s,tsv) skipspace(s)
-# define PEEKSPACE(s) skipspace(s)
-
/*
* Convenience functions to return different tokens and prime the
* lexer for the next token. They all take an argument.
PL_last_lop_op = f; \
if (*s == '(') \
return REPORT( (int)FUNC1 ); \
- s = PEEKSPACE(s); \
+ s = skipspace(s); \
return REPORT( *s=='(' ? (int)FUNC1 : (int)UNIOP ); \
}
#define UNI(f) UNI3(f,XTERM,1)
PL_expect = x;
if (*s == '(')
return REPORT(FUNC);
- s = PEEKSPACE(s);
+ s = skipspace(s);
if (*s == '(')
return REPORT(FUNC);
else {
* a keyword (do this if the word is a label, e.g. goto FOO)
* int allow_pack : if true, : characters will also be allowed (require,
* use, etc. do this)
- * int allow_initial_tick : used by the "sub" lexer only.
*/
STATIC char *
PERL_ARGS_ASSERT_FORCE_WORD;
- start = SKIPSPACE1(start);
+ start = skipspace(start);
s = start;
if (isIDFIRST_lazy_if(s,UTF) ||
(allow_pack && *s == ':') )
return start;
}
if (token == METHOD) {
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (*s == '(')
PL_expect = XTERM;
else {
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
gv_fetchpvn_flags(s, len,
- (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL)
+ (PL_in_eval ? GV_ADDMULTI
: GV_ADD) | ( UTF ? SVf_UTF8 : 0 ),
kind == '$' ? SVt_PV :
kind == '@' ? SVt_PVAV :
PERL_ARGS_ASSERT_FORCE_VERSION;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
d = s;
if (*d == 'v')
version = newSVOP(OP_CONST, 0, ver);
}
else if ( (*s != ';' && *s != '{' && *s != '}' ) &&
- (s = SKIPSPACE1(s), (*s != ';' && *s != '{' && *s != '}' )))
+ (s = skipspace(s), (*s != ';' && *s != '{' && *s != '}' )))
{
PL_bufptr = s;
if (errstr)
*/
STATIC int
-S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
+S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv)
{
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
GV* indirgv;
+ /* Mustn't actually add anything to a symbol table.
+ But also don't want to "initialise" any placeholder
+ constants that might already be there into full
+ blown PVGVs with attached PVCV. */
+ GV * const gv =
+ ioname ? gv_fetchsv(ioname, GV_NOADD_NOINIT, SVt_PVCV) : NULL;
PERL_ARGS_ASSERT_INTUIT_METHOD;
if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
isUPPER(*PL_tokenbuf))
return 0;
- s = PEEKSPACE(s);
+ s = skipspace(s);
PL_bufptr = start;
PL_expect = XREF;
return *s == '(' ? FUNCMETH : METHOD;
return 0;
/* filehandle or package name makes it a method */
if (!cv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, UTF ? SVf_UTF8 : 0)) {
- s = PEEKSPACE(s);
+ s = skipspace(s);
if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
return 0; /* no assumptions -- "=>" quotes bareword */
bare_package:
if (gv && GvCV(gv)) {
SV * const sv = cv_const_sv(GvCV(gv));
if (sv)
- pkgname = SvPV_const(sv, len);
+ return gv_stashsv(sv, 0);
}
return gv_stashpvn(pkgname, len, UTF ? SVf_UTF8 : 0);
yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
is_use ? "use" : "no"));
PL_expect = XTERM;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
s = force_version(s, TRUE);
if (*s == ';' || *s == '}'
- || (s = SKIPSPACE1(s), (*s == ';' || *s == '}'))) {
+ || (s = skipspace(s), (*s == ';' || *s == '}'))) {
NEXTVAL_NEXTTOKE.opval = NULL;
force_next(WORD);
}
}
else if (*s == '>') {
s++;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (FEATURE_POSTDEREF_IS_ENABLED && (
((*s == '$' || *s == '&') && s[1] == '*')
||(*s == '$' && s[1] == '#' && s[2] == '*')
case XATTRTERM:
PL_expect = XTERMBLOCK;
grabattrs:
- s = PEEKSPACE(s);
+ s = skipspace(s);
attrs = NULL;
while (isIDFIRST_lazy_if(s,UTF)) {
I32 tmp;
newSVOP(OP_CONST, 0,
sv));
}
- s = PEEKSPACE(d);
+ s = skipspace(d);
if (*s == ':' && s[1] != ':')
- s = PEEKSPACE(s+1);
+ s = skipspace(s+1);
else if (s == d)
break; /* require real whitespace or :'s */
/* XXX losing whitespace on sequential attributes here */
PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
else
PL_expect = XTERM;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
PL_lex_allbrackets++;
TOKEN('(');
case ';':
TOKEN(0);
s++;
PL_lex_allbrackets--;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (*s == '{')
PREBLOCK(')');
TERM(')');
else
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
PL_lex_allbrackets++;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (*s == '}') {
if (PL_expect == XREF && PL_lex_state == LEX_INTERPNORMAL) {
PL_expect = XTERM;
}
OPERATOR(HASHBRACK);
}
+ if (PL_expect == XREF && PL_oldoldbufptr != PL_last_lop) {
+ /* ${...} or @{...} etc., but not print {...} */
+ PL_expect = XTERM;
+ break;
+ }
/* This hack serves to disambiguate a pair of curlies
* as being a block or an anon hash. Normally, expectation
* determines that, but in cases where we're not in a
if (*s == '\'' || *s == '"' || *s == '`') {
/* common case: get past first string, handling escapes */
for (t++; t < PL_bufend && *t != *s;)
- if (*t++ == '\\' && (*t == '\\' || *t == *s))
+ if (*t++ == '\\')
t++;
t++;
}
{
const char tmp = *s;
if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
&& intuit_more(s)) {
while (isSPACE(*t) || isWORDCHAR_lazy_if(t,UTF) || *t == '$')
t++;
if (*t++ == ',') {
- PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
+ PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */
while (t < PL_bufend && *t != ']')
t++;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
PREREF('@');
}
if (PL_lex_state == LEX_NORMAL)
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
if (*s == '{')
PL_tokenbuf[0] = '%';
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
if (!isALPHA(*start) && (PL_expect == XTERM
- || PL_expect == XREF || PL_expect == XSTATE
+ || PL_expect == XSTATE
|| PL_expect == XTERMORDORDOR)) {
GV *const gv = gv_fetchpvn_flags(s, start - s,
UTF ? SVf_UTF8 : 0, SVt_PVCV);
just_a_word: {
int pkgname = 0;
const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
- const char penultchar =
- lastchar && PL_bufptr - 2 >= PL_linestart
- ? PL_bufptr[-2]
- : 0;
+ bool safebw;
/* Get the rest if it looks like a package qualifier */
no_op("Bareword",s);
}
- /* Look for a subroutine with this name in current package,
- unless this is a lexical sub, or name is "Foo::",
+ /* See if the name is "Foo::",
in which case Foo is a bareword
(and a package name). */
PL_tokenbuf[len] = '\0';
gv = NULL;
gvp = 0;
+ safebw = TRUE;
}
else {
- if (!lex && !gv) {
- /* Mustn't actually add anything to a symbol table.
- But also don't want to "initialise" any placeholder
- constants that might already be there into full
- blown PVGVs with attached PVCV. */
- gv = gv_fetchpvn_flags(PL_tokenbuf, len,
- GV_NOADD_NOINIT | ( UTF ? SVf_UTF8 : 0 ),
- SVt_PVCV);
- }
- len = 0;
+ safebw = FALSE;
}
/* if we saw a global override before, get the right name */
if (!sv)
sv = S_newSV_maybe_utf8(aTHX_ PL_tokenbuf,
- len ? len : strlen(PL_tokenbuf));
+ len);
if (gvp) {
SV * const tmp_sv = sv;
sv = newSVpvs("CORE::GLOBAL::");
pl_yylval.opval->op_private = OPpCONST_BARE;
/* And if "Foo::", then that's what it certainly is. */
- if (len)
+ if (safebw)
goto safe_bareword;
if (!off)
{
OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(sv));
const_op->op_private = OPpCONST_BARE;
- rv2cv_op = newCVREF(0, const_op);
- cv = lex ? GvCV(gv) : rv2cv_op_cv(rv2cv_op, 0);
+ 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);
}
+ /* Use this var to track whether intuit_method has been
+ called. intuit_method returns 0 or > 255. */
+ tmp = 1;
+
/* See if it's the indirect object for a list operator. */
if (PL_oldoldbufptr &&
bool immediate_paren = *s == '(';
/* (Now we can afford to cross potential line boundary.) */
- s = SKIPSPACE2(s,nextPL_nextwhite);
+ s = skipspace(s);
/* Two barewords in a row may indicate method call. */
if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
- (tmp = intuit_method(s, gv, cv))) {
- 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);
+ (tmp = intuit_method(s, lex ? NULL : sv, cv))) {
+ goto method;
}
/* If not a declared subroutine, it's an indirect object. */
if (*s == '=' && s[1] == '>' && !pkgname) {
op_free(rv2cv_op);
CLINE;
- /* This is our own scalar, created a few lines above,
- so this is safe. */
- SvREADONLY_off(cSVOPx(pl_yylval.opval)->op_sv);
- sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
- if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVOP*)pl_yylval.opval)->op_sv);
- SvREADONLY_on(cSVOPx(pl_yylval.opval)->op_sv);
+ 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(WORD);
}
}
NEXTVAL_NEXTTOKE.opval =
off ? rv2cv_op : pl_yylval.opval;
- PL_expect = XOPERATOR;
if (off)
op_free(pl_yylval.opval), force_next(PRIVATEREF);
else op_free(rv2cv_op), force_next(WORD);
/* If followed by a bareword, see if it looks like indir obj. */
- if (!orig_keyword
+ if (tmp == 1 && !orig_keyword
&& (isIDFIRST_lazy_if(s,UTF) || *s == '$')
- && (tmp = intuit_method(s, gv, cv))) {
+ && (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)
/* Not a method, so call it a subroutine (if defined) */
if (cv) {
- if (lastchar == '-' && penultchar != '-') {
- const STRLEN l = len ? len : strlen(PL_tokenbuf);
- Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Ambiguous use of -%"UTF8f" resolved as -&%"UTF8f"()",
- UTF8fARG(UTF, l, PL_tokenbuf),
- UTF8fARG(UTF, l, PL_tokenbuf));
- }
/* Check for a constant sub */
if ((sv = cv_const_sv_or_av(cv))) {
its_constant:
PREBLOCK(DEFAULT);
case KEY_do:
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'') {
1, &len);
if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE"))
&& !keyword(PL_tokenbuf + 1, len, 0)) {
- d = SKIPSPACE1(d);
+ d = skipspace(d);
if (*d == '(') {
force_ident_maybe_lex('&');
s = d;
UNI(OP_EXIT);
case KEY_eval:
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (*s == '{') { /* block eval */
PL_expect = XTERMBLOCK;
UNIBRACK(OP_ENTERTRY);
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
return REPORT(0);
pl_yylval.ival = CopLINE(PL_curcop);
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
char *p = s;
else if ((PL_bufend - p) >= 4 &&
strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
p += 3;
- p = PEEKSPACE(p);
+ p = skipspace(p);
/* skip optional package name, as in "for my abc $x (..)" */
if (isIDFIRST_lazy_if(p,UTF)) {
p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
- p = PEEKSPACE(p);
+ p = skipspace(p);
}
if (*p != '$')
Perl_croak(aTHX_ "Missing $ on loop variable");
case KEY_my:
case KEY_state:
PL_in_my = (U16)tmp;
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (isIDFIRST_lazy_if(s,UTF)) {
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3))
TOKEN(USE);
case KEY_not:
- if (*s == '(' || (s = SKIPSPACE1(s), *s == '('))
+ if (*s == '(' || (s = skipspace(s), *s == '('))
FUN1(OP_NOT);
else {
if (!PL_lex_allbrackets &&
}
case KEY_open:
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (isIDFIRST_lazy_if(s,UTF)) {
const char *t;
d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE,
case KEY_package:
s = force_word(s,WORD,FALSE,TRUE);
- s = SKIPSPACE1(s);
+ s = skipspace(s);
s = force_strict_version(s);
PREBLOCK(PACKAGE);
OLDLOP(OP_RETURN);
case KEY_require:
- s = SKIPSPACE1(s);
+ s = skipspace(s);
if (isDIGIT(*s)) {
s = force_version(s, FALSE);
}
case KEY_sort:
checkcomma(s,PL_tokenbuf,"subroutine name");
- s = SKIPSPACE1(s);
+ s = skipspace(s);
PL_expect = XTERM;
s = force_word(s,WORD,TRUE,TRUE);
LOP(OP_SORT,XREF);
pl_yylval.opval->op_private = OPpCONST_ENTERED;
if (pit != '&')
gv_fetchsv(sym,
- (PL_in_eval
- ? (GV_ADDMULTI | GV_ADDINEVAL)
- : GV_ADDMULTI
- ),
+ GV_ADDMULTI,
((PL_tokenbuf[0] == '$') ? SVt_PV
: (PL_tokenbuf[0] == '@') ? SVt_PVAV
: SVt_PVHV));
pl_yylval.opval->op_private = OPpCONST_ENTERED;
if (pit != '&')
gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
- (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD)
+ (PL_in_eval ? GV_ADDMULTI : GV_ADD)
| ( UTF ? SVf_UTF8 : 0 ),
((PL_tokenbuf[0] == '$') ? SVt_PV
: (PL_tokenbuf[0] == '@') ? SVt_PVAV
s++;
if (*s == ',') {
GV* gv;
+ PADOFFSET off;
if (keyword(w, s - w, 0))
return;
gv = gv_fetchpvn_flags(w, s - w, ( UTF ? SVf_UTF8 : 0 ), SVt_PVCV);
if (gv && GvCVu(gv))
return;
+ if (s - w <= 254) {
+ char tmpbuf[256];
+ Copy(w, tmpbuf+1, s - w, char);
+ *tmpbuf = '&';
+ off = pad_findmy_pvn(tmpbuf, s-w+1, UTF ? SVf_UTF8 : 0);
+ if (off != NOT_IN_PAD) return;
+ }
Perl_croak(aTHX_ "No comma allowed after %s", what);
}
}
PERL_ARGS_ASSERT_SCAN_IDENT;
if (isSPACE(*s))
- s = PEEKSPACE(s);
+ s = skipspace(s);
if (isDIGIT(*s)) {
while (isDIGIT(*s)) {
if (d >= e)
s++;
orig_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
- s = PEEKSPACE(s);
+ s = skipspace(s);
}
}
*d = '\0';
tmp_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
- s = PEEKSPACE(s);
+ s = skipspace(s);
}
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
/* ${foo[0]} and ${foo{bar}} notation. */
if ( !tmp_copline )
tmp_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
- s = PEEKSPACE(s);
+ s = skipspace(s);
}
/* Expect to find a closing } after consuming any trailing whitespace.
else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
PL_bufend[-1] = '\n';
#endif
- if (*s == term && memEQ(s,PL_tokenbuf + 1,len)) {
+ if (*s == term && PL_bufend-s >= len
+ && memEQ(s,PL_tokenbuf + 1,len)) {
SvREFCNT_dec(PL_linestr);
PL_linestr = linestr_save;
PL_linestart = SvPVX(linestr_save);
++d;
intro_sym:
gv = gv_fetchpv(d,
- (PL_in_eval
- ? (GV_ADDMULTI | GV_ADDINEVAL)
- : GV_ADDMULTI) | ( UTF ? SVf_UTF8 : 0 ),
+ GV_ADDMULTI | ( UTF ? SVf_UTF8 : 0 ),
SVt_PV);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
/* skip space before the delimiter */
if (isSPACE(*s)) {
- s = PEEKSPACE(s);
+ s = skipspace(s);
}
/* mark where we are, in case we need to report errors */
https://perl5.git.perl.org / perl5.git / blobdiff