{ WHEN, TOKENTYPE_IVAL, "WHEN" },
{ WHILE, TOKENTYPE_IVAL, "WHILE" },
{ WORD, TOKENTYPE_OPVAL, "WORD" },
+ { YADAYADA, TOKENTYPE_IVAL, "YADAYADA" },
{ 0, TOKENTYPE_NONE, NULL }
};
#ifdef DEBUGGING
if (DEBUG_T_TEST) {
PerlIO_printf(Perl_debug_log, "### forced token:\n");
- tokereport(THING, &NEXTVAL_NEXTTOKE);
+ tokereport(type, &NEXTVAL_NEXTTOKE);
}
#endif
#ifdef PERL_MAD
sv_free((SV*)PL_preambleav);
PL_preambleav = NULL;
}
+ if (PL_minus_E)
+ sv_catpvs(PL_linestr,
+ "use feature ':5." STRINGIFY(PERL_VERSION) "';");
if (PL_minus_n || PL_minus_p) {
sv_catpvs(PL_linestr, "LINE: while (<>) {");
if (PL_minus_l)
sv_catpvs(PL_linestr,"our @F=split(' ');");
}
}
- if (PL_minus_E)
- sv_catpvs(PL_linestr,
- "use feature ':5." STRINGIFY(PERL_VERSION) "';");
sv_catpvs(PL_linestr, "\n");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
pl_yylval.ival = 0;
OPERATOR(ASSIGNOP);
case '!':
+ if (PL_expect == XSTATE && s[1] == '!' && s[2] == '!') {
+ s += 3;
+ LOP(OP_DIE,XTERM);
+ }
s++;
{
const char tmp = *s++;
AOPERATOR(DORDOR);
}
case '?': /* may either be conditional or pattern */
- if(PL_expect == XOPERATOR) {
+ if (PL_expect == XSTATE && s[1] == '?' && s[2] == '?') {
+ s += 3;
+ LOP(OP_WARN,XTERM);
+ }
+ if (PL_expect == XOPERATOR) {
char tmp = *s++;
if(tmp == '?') {
- OPERATOR('?');
+ OPERATOR('?');
}
else {
tmp = *s++;
PL_expect = XSTATE;
goto rightbracket;
}
+ if (PL_expect == XSTATE && s[1] == '.' && s[2] == '.') {
+ s += 3;
+ OPERATOR(YADAYADA);
+ }
if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
char tmp = *s++;
if (*s == tmp) {
/* Call it a bare word */
+ bareword:
if (PL_hints & HINT_STRICT_SUBS)
pl_yylval.opval->op_private |= OPpCONST_STRICT;
else {
- bareword:
if (lastchar != '-') {
if (ckWARN(WARN_RESERVED)) {
d = PL_tokenbuf;
(*s == ':' && s[1] == ':'))
{
#ifdef PERL_MAD
- SV *nametoke;
+ SV *nametoke = NULL;
#endif
PL_expect = XBLOCK;
if (*s == '(') {
char *p;
bool bad_proto = FALSE;
+ bool in_brackets = FALSE;
+ char greedy_proto = ' ';
+ bool proto_after_greedy_proto = FALSE;
+ bool must_be_last = FALSE;
+ bool underscore = FALSE;
+ bool seen_underscore = FALSE;
const bool warnsyntax = ckWARN(WARN_SYNTAX);
s = scan_str(s,!!PL_madskills,FALSE);
for (p = d; *p; ++p) {
if (!isSPACE(*p)) {
d[tmp++] = *p;
- if (warnsyntax && !strchr("$@%*;[]&\\_", *p))
- bad_proto = TRUE;
+
+ if (warnsyntax) {
+ if (must_be_last)
+ proto_after_greedy_proto = TRUE;
+ if (!strchr("$@%*;[]&\\_", *p)) {
+ bad_proto = TRUE;
+ }
+ else {
+ if ( underscore ) {
+ if ( *p != ';' )
+ bad_proto = TRUE;
+ underscore = FALSE;
+ }
+ if ( *p == '[' ) {
+ in_brackets = TRUE;
+ }
+ else if ( *p == ']' ) {
+ in_brackets = FALSE;
+ }
+ else if ( (*p == '@' || *p == '%') &&
+ ( tmp < 2 || d[tmp-2] != '\\' ) &&
+ !in_brackets ) {
+ must_be_last = TRUE;
+ greedy_proto = *p;
+ }
+ else if ( *p == '_' ) {
+ underscore = seen_underscore = TRUE;
+ }
+ }
+ }
}
}
d[tmp] = '\0';
+ if (proto_after_greedy_proto)
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Prototype after '%c' for %"SVf" : %s",
+ greedy_proto, SVfARG(PL_subname), d);
if (bad_proto)
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Illegal character in prototype for %"SVf" : %s",
+ "Illegal character %sin prototype for %"SVf" : %s",
+ seen_underscore ? "after '_' " : "",
SVfARG(PL_subname), d);
SvCUR_set(PL_lex_stuff, tmp);
have_proto = TRUE;
register char* s;
OP *o;
short *tbl;
- I32 squash;
- I32 del;
- I32 complement;
+ U8 squash;
+ U8 del;
+ U8 complement;
#ifdef PERL_MAD
char *modstart;
#endif
bool eofmt = FALSE;
#ifdef PERL_MAD
char *tokenstart = s;
- SV* savewhite;
-
+ SV* savewhite = NULL;
+
if (PL_madskills) {
savewhite = PL_thiswhite;
PL_thiswhite = 0;