{ GIVEN, TOKENTYPE_IVAL, "GIVEN" },
{ HASHBRACK, TOKENTYPE_NONE, "HASHBRACK" },
{ IF, TOKENTYPE_IVAL, "IF" },
- { LABEL, TOKENTYPE_PVAL, "LABEL" },
+ { LABEL, TOKENTYPE_OPVAL, "LABEL" },
{ LOCAL, TOKENTYPE_IVAL, "LOCAL" },
{ LOOPEX, TOKENTYPE_OPNUM, "LOOPEX" },
{ LSTOP, TOKENTYPE_OPNUM, "LSTOP" },
case FUNC0SUB:
case UNIOPSUB:
case LSTOPSUB:
+ case LABEL:
if (pl_yylval.opval)
append_madprops(PL_thismad, pl_yylval.opval, 0);
PL_thismad = 0;
}
break;
- /* pval */
- case LABEL:
- break;
-
/* ival */
default:
break;
if (!anydelim && PL_expect == XSTATE
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
- pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ newSVpvn_flags(PL_tokenbuf,
+ len, UTF ? SVf_UTF8 : 0));
CLINE;
TOKEN(LABEL);
}
s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
TRUE, &morelen);
if (!morelen)
- Perl_croak(aTHX_ "Bad name after %s%s", PL_tokenbuf,
+ Perl_croak(aTHX_ "Bad name after %"SVf"%s",
+ SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+ (UTF ? SVf_UTF8 : 0) | SVs_TEMP )),
*s == '\'' ? "'" : "::");
len += morelen;
pkgname = 1;
if (ckWARN(WARN_BAREWORD)
&& ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
- "Bareword \"%s\" refers to nonexistent package",
- PL_tokenbuf);
+ "Bareword \"%"SVf"\" refers to nonexistent package",
+ SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+ (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
len -= 2;
PL_tokenbuf[len] = '\0';
gv = NULL;
/* Not a method, so call it a subroutine (if defined) */
if (cv) {
- if (lastchar == '-')
- Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Ambiguous use of -%s resolved as -&%s()",
- PL_tokenbuf, PL_tokenbuf);
+ if (lastchar == '-') {
+ const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP );
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+ "Ambiguous use of -%"SVf" resolved as -&%"SVf"()",
+ SVfARG(tmpsv), SVfARG(tmpsv));
+ }
/* Check for a constant sub */
if ((sv = cv_const_sv(cv))) {
its_constant:
d = s;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
if (!(tmp = keyword(PL_tokenbuf, len, 1)))
- Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
+ Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword",
+ SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+ (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
if (tmp < 0)
tmp = -tmp;
else if (tmp == KEY_require || tmp == KEY_do
s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
const char *t;
- for (d = s; isALNUM_lazy_if(d,UTF);)
- d++;
+ for (d = s; isALNUM_lazy_if(d,UTF);) {
+ d += UTF ? UTF8SKIP(d) : 1;
+ if (UTF) {
+ while (UTF8_IS_CONTINUED(*d) && is_utf8_mark((U8*)d)) {
+ d += UTF ? UTF8SKIP(d) : 1;
+ }
+ }
+ }
for (t=d; isSPACE(*t);)
t++;
if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
&& !(t[0] == ':' && t[1] == ':')
&& !keyword(s, d-s, 0)
) {
- int parms_len = (int)(d-s);
+ SV *tmpsv = newSVpvn_flags(s, (STRLEN)(d-s),
+ SVs_TEMP | (UTF ? SVf_UTF8 : 0));
Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
- "Precedence problem: open %.*s should be open(%.*s)",
- parms_len, s, parms_len, s);
+ "Precedence problem: open %"SVf" should be open(%"SVf")",
+ SVfARG(tmpsv), SVfARG(tmpsv));
}
}
LOP(OP_OPEN,XTERM);
"Illegal character %sin prototype for %"SVf" : %s",
seen_underscore ? "after '_' " : "",
SVfARG(PL_subname),
- sv_uni_display(dsv,
- newSVpvn_flags(d, tmp, SVs_TEMP | SvUTF8(PL_lex_stuff)),
- tmp, UNI_DISPLAY_ISPRINT));
+ SvUTF8(PL_lex_stuff)
+ ? sv_uni_display(dsv,
+ newSVpvn_flags(d, tmp, SVs_TEMP | SVf_UTF8),
+ tmp,
+ UNI_DISPLAY_ISPRINT)
+ : pv_pretty(dsv, d, tmp, 60, NULL, NULL,
+ PERL_PV_ESCAPE_NONASCII));
}
SvCUR_set(PL_lex_stuff, tmp);
have_proto = TRUE;
}
else {
if (has_colon)
- yyerror(Perl_form(aTHX_ PL_no_myglob,
- PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
+ yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
+ PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
+ UTF ? SVf_UTF8 : 0);
pl_yylval.opval = newOP(OP_PADANY, 0);
pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
{
/* Downgraded from fatal to warning 20000522 mjd */
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Possible unintended interpolation of %s in string",
- PL_tokenbuf);
+ "Possible unintended interpolation of %"SVf" in string",
+ SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len,
+ SVs_TEMP | ( UTF ? SVf_UTF8 : 0 ))));
}
}
while (s < PL_bufend && isSPACE(*s))
s++;
if (isIDFIRST_lazy_if(s,UTF)) {
- const char * const w = s++;
+ const char * const w = s;
+ s += UTF ? UTF8SKIP(s) : 1;
while (isALNUM_lazy_if(s,UTF))
- s++;
+ s += UTF ? UTF8SKIP(s) : 1;
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ',') {
for (;;) {
if (d >= e)
Perl_croak(aTHX_ ident_too_long);
- if (isALNUM(*s)) /* UTF handled below */
+ if (isALNUM(*s) || (!UTF && isALNUMC_L1(*s))) /* UTF handled below */
*d++ = *s++;
else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) {
*d++ = ':';
bracket = s;
s++;
}
- else if (ck_uni)
- check_uni();
if (s < send) {
if (UTF) {
const STRLEN skip = UTF8SKIP(s);
*d = toCTRL(*s);
s++;
}
+ else if (ck_uni && !bracket)
+ check_uni();
if (bracket) {
if (isSPACE(s[-1])) {
while (s < send) {
if (PL_lex_state == LEX_NORMAL) {
if (ckWARN(WARN_AMBIGUOUS) &&
(keyword(dest, d - dest, 0)
- || get_cvn_flags(dest, d - dest, 0)))
+ || get_cvn_flags(dest, d - dest, UTF ? SVf_UTF8 : 0)))
{
+ SV *tmp = newSVpvn_flags( dest, d - dest,
+ SVs_TEMP | (UTF ? SVf_UTF8 : 0) );
if (funny == '#')
funny = '@';
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Ambiguous use of %c{%s} resolved to %c%s",
- funny, dest, funny, dest);
+ "Ambiguous use of %c{%"SVf"} resolved to %c%"SVf,
+ funny, tmp, funny, tmp);
}
}
}
if (PL_lex_state == LEX_KNOWNEXT) {
PL_parser->yychar = yylex();
if (PL_parser->yychar == LABEL) {
- char *lpv = pl_yylval.pval;
- STRLEN llen = strlen(lpv);
SV *lsv;
PL_parser->yychar = YYEMPTY;
lsv = newSV_type(SVt_PV);
- SvPV_set(lsv, lpv);
- SvCUR_set(lsv, llen);
- SvLEN_set(lsv, llen+1);
- SvPOK_on(lsv);
+ sv_copypv(lsv, cSVOPx(pl_yylval.opval)->op_sv);
return lsv;
} else {
yyunlex();
}
} else {
char *s, *t;
- U8 c;
STRLEN wlen, bufptr_pos;
lex_read_space(0);
t = s = PL_bufptr;
- c = (U8)*s;
- if (!isIDFIRST_A(c))
+ if (!isIDFIRST_lazy_if(s, UTF))
goto no_label;
- do {
- c = (U8)*++t;
- } while(isWORDCHAR_A(c));
- wlen = t - s;
+ t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen);
if (word_takes_any_delimeter(s, wlen))
goto no_label;
bufptr_pos = s - SvPVX(PL_linestr);
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
PL_bufptr = t+1;
- return newSVpvn(s, wlen);
+ return newSVpvn_flags(s, wlen, UTF ? SVf_UTF8 : 0);
} else {
PL_bufptr = s;
no_label:
return stmtseqop;
}
-void
-Perl_munge_qwlist_to_paren_list(pTHX_ OP *qwlist)
-{
- PERL_ARGS_ASSERT_MUNGE_QWLIST_TO_PAREN_LIST;
- deprecate("qw(...) as parentheses");
- force_next((4<<24)|')');
- if (qwlist->op_type == OP_STUB) {
- op_free(qwlist);
- }
- else {
- start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = qwlist;
- force_next(THING);
- }
- force_next((2<<24)|'(');
-}
-
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/