* 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 *
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 :
*/
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 (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);
}
/* 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;
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). */
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);
- }
safebw = FALSE;
}
rv2cv_op =
newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op);
cv = lex
- ? isGV(gv) ? GvCV(gv) : (CV *)gv
+ ? 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 &&
/* 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);
}
/* 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) {
- OP *gvop;
- 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:
TOKEN(WORD);
}
- /* Resolve to GV now if this is a placeholder. */
- if (!off && (gvop = cUNOPx(rv2cv_op)->op_first)
- && gvop->op_type == OP_GV) {
- GV *gv2 = cGVOPx_gv(gvop);
- if (gv2 && !isGV(gv2)) {
- gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
- assert (SvTYPE(gv) == SVt_PVGV);
- /* cv must have been some sort of placeholder,
- so now needs replacing with a real code
- reference. */
- cv = GvCV(gv);
- }
- }
-
op_free(pl_yylval.opval);
pl_yylval.opval =
off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op;
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);
}
}
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,