implement C<goto &func> and other fixes (via private mail)
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index c4ecaa8..839ef14 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -61,6 +61,18 @@ static void restore_lex_expect _((void *e));
 static char ident_too_long[] = "Identifier too long";
 
 #define UTF (PL_hints & HINT_UTF8)
+/*
+ * Note: we try to be careful never to call the isXXX_utf8() functions
+ * unless we're pretty sure we've seen the beginning of a UTF-8 character
+ * (that is, the two high bits are set).  Otherwise we risk loading in the
+ * heavy-duty SWASHINIT and SWASHGET routines unnecessarily.
+ */
+#define isIDFIRST_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
+                               ? isIDFIRST(*(p)) \
+                               : isIDFIRST_utf8((U8*)p))
+#define isALNUM_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
+                               ? isALNUM(*(p)) \
+                               : isALNUM_utf8((U8*)p))
 
 /* The following are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
@@ -181,9 +193,9 @@ no_op(char *what, char *s)
     yywarn(form("%s found where operator expected", what));
     if (is_first)
        warn("\t(Missing semicolon on previous line?)\n");
-    else if (PL_oldoldbufptr && isIDFIRST(*PL_oldoldbufptr)) {
+    else if (PL_oldoldbufptr && isIDFIRST_lazy(PL_oldoldbufptr)) {
        char *t;
-       for (t = PL_oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
+       for (t = PL_oldoldbufptr; *t && (isALNUM_lazy(t) || *t == ':'); t++) ;
        if (t < PL_bufptr && isSPACE(*t))
            warn("\t(Do you need to predeclare %.*s?)\n",
                t - PL_oldoldbufptr, PL_oldoldbufptr);
@@ -490,7 +502,7 @@ check_uni(void) {
        return;
     while (isSPACE(*PL_last_uni))
        PL_last_uni++;
-    for (s = PL_last_uni; isALNUM(*s) || *s == '-'; s++) ;
+    for (s = PL_last_uni; isALNUM_lazy(s) || *s == '-'; s++) ;
     if ((t = strchr(s, '(')) && t < PL_bufptr)
        return;
     ch = *s;
@@ -566,7 +578,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i
     
     start = skipspace(start);
     s = start;
-    if (isIDFIRST(*s) ||
+    if (isIDFIRST_lazy(s) ||
        (allow_pack && *s == ':') ||
        (allow_initial_tick && *s == '\'') )
     {
@@ -1007,7 +1019,7 @@ scan_const(char *start)
        }
 
        /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
-       else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
+       else if (*s == '@' && s[1] && (isALNUM_lazy(s+1) || strchr(":'{$", s[1])))
            break;
 
        /* check for embedded scalars.  only stop if we're sure it's a
@@ -1263,7 +1275,7 @@ intuit_more(register char *s)
            case '&':
            case '$':
                weight -= seen[un_char] * 10;
-               if (isALNUM(s[1])) {
+               if (isALNUM_lazy(s+1)) {
                    scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
                    if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
                        weight -= 100;
@@ -1879,16 +1891,8 @@ int yylex
   retry:
     switch (*s) {
     default:
-       /*
-        * Note: we try to be careful never to call the isXXX_utf8() functions unless we're
-        * pretty sure we've seen the beginning of a UTF-8 character (that is, the two high
-        * bits are set).  Otherwise we risk loading in the heavy-duty SWASHINIT and SWASHGET
-        * routines unnecessarily.  You will see this not just here but throughout this file.
-        */
-       if (UTF && (*s & 0xc0) == 0x80) {
-           if (isIDFIRST_utf8((U8*)s))
-               goto keylookup;
-       }
+       if (isIDFIRST_lazy(s))
+           goto keylookup;
        croak("Unrecognized character \\x%02X", *s & 255);
     case 4:
     case 26:
@@ -2239,7 +2243,7 @@ int yylex
        else if (*s == '>') {
            s++;
            s = skipspace(s);
-           if (isIDFIRST(*s)) {
+           if (isIDFIRST_lazy(s)) {
                s = force_word(s,METHOD,FALSE,TRUE,FALSE);
                TOKEN(ARROW);
            }
@@ -2384,7 +2388,7 @@ int yylex
                while (d < PL_bufend && (*d == ' ' || *d == '\t'))
                    d++;
            }
-           if (d < PL_bufend && isIDFIRST(*d)) {
+           if (d < PL_bufend && isIDFIRST_lazy(d)) {
                d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
                              FALSE, &len);
                while (d < PL_bufend && (*d == ' ' || *d == '\t'))
@@ -2472,8 +2476,8 @@ int yylex
                    }
                    t++;
                }
-               else if (isALPHA(*s)) {
-                   for (t++; t < PL_bufend && isALNUM(*t); t++) ;
+               else if (isIDFIRST_lazy(s)) {
+                   for (t++; t < PL_bufend && isALNUM_lazy(t); t++) ;
                }
                while (t < PL_bufend && isSPACE(*t))
                    t++;
@@ -2483,7 +2487,7 @@ int yylex
                                   || (*t == '=' && t[1] == '>')))
                    OPERATOR(HASHBRACK);
                if (PL_expect == XREF)
-                   PL_expect = XTERM;
+                   PL_expect = XSTATE; /* was XTERM, trying XSTATE */
                else {
                    PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
                    PL_expect = XSTATE;
@@ -2531,7 +2535,7 @@ int yylex
            AOPERATOR(ANDAND);
        s--;
        if (PL_expect == XOPERATOR) {
-           if (ckWARN(WARN_SEMICOLON) && isALPHA(*s) && PL_bufptr == PL_linestart) {
+           if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
                PL_curcop->cop_line--;
                warner(WARN_SEMICOLON, warn_nosemi);
                PL_curcop->cop_line++;
@@ -2661,7 +2665,7 @@ int yylex
            }
        }
 
-       if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:+-", s[2]))) {
+       if (s[1] == '#' && (isIDFIRST_lazy(s+2) || strchr("{$:+-", s[2]))) {
            if (PL_expect == XOPERATOR)
                no_op("Array length", PL_bufptr);
            PL_tokenbuf[0] = '@';
@@ -2702,7 +2706,7 @@ int yylex
                PL_tokenbuf[0] = '@';
                if (ckWARN(WARN_SYNTAX)) {
                    for(t = s + 1;
-                       isSPACE(*t) || isALNUM(*t) || *t == '$';
+                       isSPACE(*t) || isALNUM_lazy(t) || *t == '$';
                        t++) ;
                    if (*t++ == ',') {
                        PL_bufptr = skipspace(PL_bufptr);
@@ -2722,7 +2726,7 @@ int yylex
                    char tmpbuf[sizeof PL_tokenbuf];
                    STRLEN len;
                    for (t++; isSPACE(*t); t++) ;
-                   if (isIDFIRST(*t)) {
+                   if (isIDFIRST_lazy(t)) {
                        t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
                        if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
                            warner(WARN_SYNTAX,
@@ -2739,9 +2743,9 @@ int yylex
                PL_expect = XOPERATOR;
            else if (strchr("$@\"'`q", *s))
                PL_expect = XTERM;              /* e.g. print $fh "foo" */
-           else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
+           else if (strchr("&*<%", *s) && isIDFIRST_lazy(s+1))
                PL_expect = XTERM;              /* e.g. print $fh &sub */
-           else if (isIDFIRST(*s)) {
+           else if (isIDFIRST_lazy(s)) {
                char tmpbuf[sizeof PL_tokenbuf];
                scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
                if (tmp = keyword(tmpbuf, len)) {
@@ -2799,7 +2803,7 @@ int yylex
            if (ckWARN(WARN_SYNTAX)) {
                if (*s == '[' || *s == '{') {
                    char *t = s + 1;
-                   while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
+                   while (*t && (isALNUM_lazy(t) || strchr(" \t$#+-'\"", *t)))
                        t++;
                    if (*t == '}' || *t == ']') {
                        t++;
@@ -2820,7 +2824,7 @@ int yylex
            /* Disable warning on "study /blah/" */
            if (PL_oldoldbufptr == PL_last_uni 
                && (*PL_last_uni != 's' || s - PL_last_uni < 5 
-                   || memNE(PL_last_uni, "study", 5) || isALNUM(PL_last_uni[5])))
+                   || memNE(PL_last_uni, "study", 5) || isALNUM_lazy(PL_last_uni+5)))
                check_uni();
            s = scan_pat(s,OP_MATCH);
            TERM(sublex_start());
@@ -3133,7 +3137,7 @@ int yylex
 
                    /* Two barewords in a row may indicate method call. */
 
-                   if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
+                   if ((isIDFIRST_lazy(s) || *s == '$') && (tmp=intuit_method(s,gv)))
                        return tmp;
 
                    /* If not a declared subroutine, it's an indirect object. */
@@ -3154,8 +3158,11 @@ int yylex
                if (*s == '(') {
                    CLINE;
                    if (gv && GvCVu(gv)) {
+                       CV *cv;
+                       if ((cv = GvCV(gv)) && SvPOK(cv))
+                           PL_last_proto = SvPV((SV*)cv, PL_na);
                        for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
-                       if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+                       if (*d == ')' && (sv = cv_const_sv(cv))) {
                            s = d + 1;
                            goto its_constant;
                        }
@@ -3164,6 +3171,7 @@ int yylex
                    PL_expect = XOPERATOR;
                    force_next(WORD);
                    yylval.ival = 0;
+                   PL_last_lop_op = OP_ENTERSUB;
                    TOKEN('&');
                }
 
@@ -3177,7 +3185,7 @@ int yylex
 
                /* If followed by a bareword, see if it looks like indir obj. */
 
-               if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
+               if ((isIDFIRST_lazy(s) || *s == '$') && (tmp = intuit_method(s,gv)))
                    return tmp;
 
                /* Not a method, so call it a subroutine (if defined) */
@@ -3202,6 +3210,7 @@ int yylex
                    /* Resolve to GV now. */
                    op_free(yylval.opval);
                    yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+                   PL_last_lop_op = OP_ENTERSUB;
                    /* Is there a prototype? */
                    if (SvPOK(cv)) {
                        STRLEN len;
@@ -3228,7 +3237,10 @@ int yylex
                    PL_last_lop_op != OP_TRUNCATE &&  /* S/F prototype in opcode.pl */
                    PL_last_lop_op != OP_ACCEPT &&
                    PL_last_lop_op != OP_PIPE_OP &&
-                   PL_last_lop_op != OP_SOCKPAIR)
+                   PL_last_lop_op != OP_SOCKPAIR &&
+                   !(PL_last_lop_op == OP_ENTERSUB 
+                        && PL_last_proto 
+                        && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
                {
                    warn(
                     "Bareword \"%s\" not allowed while \"strict subs\" in use",
@@ -3491,13 +3503,13 @@ int yylex
        case KEY_foreach:
            yylval.ival = PL_curcop->cop_line;
            s = skipspace(s);
-           if (PL_expect == XSTATE && isIDFIRST(*s)) {
+           if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
                char *p = s;
                if ((PL_bufend - p) >= 3 &&
                    strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
                    p += 2;
                p = skipspace(p);
-               if (isIDFIRST(*p))
+               if (isIDFIRST_lazy(p))
                    croak("Missing $ on loop variable");
            }
            OPERATOR(FOR);
@@ -3685,7 +3697,7 @@ int yylex
            TERM(sublex_start());
 
        case KEY_map:
-           LOP(OP_MAPSTART,XREF);
+           LOP(OP_MAPSTART, XREF);
            
        case KEY_mkdir:
            LOP(OP_MKDIR,XTERM);
@@ -3705,7 +3717,7 @@ int yylex
        case KEY_my:
            PL_in_my = TRUE;
            s = skipspace(s);
-           if (isIDFIRST(*s)) {
+           if (isIDFIRST_lazy(s)) {
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
                PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
                if (!PL_in_my_stash) {
@@ -3737,9 +3749,9 @@ int yylex
 
        case KEY_open:
            s = skipspace(s);
-           if (isIDFIRST(*s)) {
+           if (isIDFIRST_lazy(s)) {
                char *t;
-               for (d = s; isALNUM(*d); d++) ;
+               for (d = s; isALNUM_lazy(d); d++) ;
                t = skipspace(d);
                if (strchr("|&*+-=!?:.", *t))
                    warn("Precedence problem: open %.*s should be open(%.*s)",
@@ -3862,7 +3874,7 @@ int yylex
        case KEY_require:
            *PL_tokenbuf = '\0';
            s = force_word(s,WORD,TRUE,TRUE,FALSE);
-           if (isIDFIRST(*PL_tokenbuf))
+           if (isIDFIRST_lazy(PL_tokenbuf))
                gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
            else if (*s == '<')
                yyerror("<> should be quotes");
@@ -4046,7 +4058,7 @@ int yylex
          really_sub:
            s = skipspace(s);
 
-           if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
+           if (isIDFIRST_lazy(s) || *s == '\'' || *s == ':') {
                char tmpbuf[sizeof PL_tokenbuf];
                PL_expect = XBLOCK;
                d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
@@ -4918,9 +4930,9 @@ checkcomma(register char *s, char *name, char *what)
        s++;
     while (s < PL_bufend && isSPACE(*s))
        s++;
-    if (isIDFIRST(*s)) {
+    if (isIDFIRST_lazy(s)) {
        w = s++;
-       while (isALNUM(*s))
+       while (isALNUM_lazy(s))
            s++;
        while (s < PL_bufend && isSPACE(*s))
            s++;
@@ -5013,9 +5025,9 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
     for (;;) {
        if (d >= e)
            croak(ident_too_long);
-       if (isALNUM(*s))
+       if (isALNUM(*s))        /* UTF handled below */
            *d++ = *s++;
-       else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
+       else if (*s == '\'' && allow_package && isIDFIRST_lazy(s+1)) {
            *d++ = ':';
            *d++ = ':';
            s++;
@@ -5024,7 +5036,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
            *d++ = *s++;
            *d++ = *s++;
        }
-       else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
+       else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
            char *t = s + UTF8SKIP(s);
            while (*t & 0x80 && is_utf8_mark((U8*)t))
                t += UTF8SKIP(t);
@@ -5067,9 +5079,9 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
        for (;;) {
            if (d >= e)
                croak(ident_too_long);
-           if (isALNUM(*s))
+           if (isALNUM(*s))    /* UTF handled below */
                *d++ = *s++;
-           else if (*s == '\'' && isIDFIRST(s[1])) {
+           else if (*s == '\'' && isIDFIRST_lazy(s+1)) {
                *d++ = ':';
                *d++ = ':';
                s++;
@@ -5078,7 +5090,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
                *d++ = *s++;
                *d++ = *s++;
            }
-           else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
+           else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
                char *t = s + UTF8SKIP(s);
                while (*t & 0x80 && is_utf8_mark((U8*)t))
                    t += UTF8SKIP(t);
@@ -5100,7 +5112,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
        return s;
     }
     if (*s == '$' && s[1] &&
-       (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+       (isALNUM_lazy(s+1) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
     {
        return s;
     }
@@ -5127,11 +5139,11 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
                }
            }
        }
-       if (isIDFIRST(*d) || (UTF && (*d & 0xc0) == 0x80 && isIDFIRST_utf8((U8*)d))) {
+       if (isIDFIRST_lazy(d)) {
            d++;
            if (UTF) {
                e = s;
-               while (e < send && (isALNUM(*e) || ((*e & 0xc0) == 0x80 && isALNUM_utf8((U8*)e)) || *e == ':')) {
+               while (e < send && isALNUM_lazy(e) || *e == ':') {
                    e += UTF8SKIP(e);
                    while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
                        e += UTF8SKIP(e);
@@ -5417,9 +5429,9 @@ scan_heredoc(register char *s)
            s++, term = '\'';
        else
            term = '"';
-       if (!isALNUM(*s))
+       if (!isALNUM_lazy(s))
            deprecate("bare << to mean <<\"\"");
-       for (; isALNUM(*s); s++) {
+       for (; isALNUM_lazy(s); s++) {
            if (d < e)
                *d++ = *s;
        }
@@ -5600,7 +5612,7 @@ scan_inputsymbol(char *start)
     if (*d == '$' && d[1]) d++;
 
     /* allow <Pkg'VALUE> or <Pkg::VALUE> */
-    while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
+    while (*d && (isALNUM_lazy(d) || *d == '\'' || *d == ':'))
        d++;
 
     /* If we've tried to read what we allow filehandles to look like, and