Program with utf8 identifiers fails to compile

p4raw-id: //depot/perl@2038

diff --git a/doop.c b/doop.c
index 5390331..7ed895d 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -215,10 +215,9 @@ do_trans_UU_count(SV *sv)
     send = s + len;
 
     while (s < send) {
-       if ((uv = swash_fetch(rv, s)) < none) {
-           s += UTF8SKIP(s);
+       if ((uv = swash_fetch(rv, s)) < none)
            matches++;
-       }
+       s += UTF8SKIP(s);
     }
 
     return matches;

diff --git a/gv.c b/gv.c
index 57e3ff1..e040a41 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -500,7 +500,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     /* No stash in name, so see how we can default */
 
     if (!stash) {
-       if (isIDFIRST(*name)) {
+       if (isIDFIRST(*name) || (IN_UTF8 && ((*name & 0xc0) == 0xc0) && isIDFIRST_utf8(name))) {
            bool global = FALSE;
 
            if (isUPPER(*name)) {

diff --git a/op.c b/op.c
index f9c9df1..6e2cc64 100644 (file)
--- a/op.c
+++ b/op.c
@@ -120,7 +120,11 @@ pad_allocmy(char *name)
     PADOFFSET off;
     SV *sv;
 
-    if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
+    if (!(
+       isALPHA(name[1]) ||
+       (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
+       name[1] == '_' && (int)strlen(name) > 2))
+    {
        if (!isPRINT(name[1])) {
            name[3] = '\0';
            name[2] = toCTRL(name[1]);
@@ -1687,7 +1691,7 @@ localize(OP *o, I32 lex)
        dTHR;
        if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
            char *s;
-           for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
+           for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
                warner(WARN_PARENTHESIS, "Parens missing around \"%s\" list",
                                lex ? "my" : "local");

diff --git a/pp.c b/pp.c
index 9d9ad5c..14c8a25 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1316,6 +1316,10 @@ PP(pp_negate)
                sv_setsv(TARG, sv);
                *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
            }
+           else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8(s)) {
+               sv_setpvn(TARG, "-", 1);
+               sv_catsv(TARG, sv);
+           }
            else
                sv_setnv(TARG, -SvNV(sv));
            SETTARG;

diff --git a/pp_hot.c b/pp_hot.c
index fa947cf..89bbba7 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2516,10 +2516,16 @@ PP(pp_method)
            !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
            !(ob=(SV*)GvIO(iogv)))
        {
-           if (!packname || !isIDFIRST(*packname))
+           if (!packname || 
+               ((*(U8*)packname >= 0xc0 && IN_UTF8)
+                   ? !isIDFIRST_utf8(packname)
+                   : !isIDFIRST(*packname)
+               ))
+           {
                DIE("Can't call method \"%s\" %s", name,
                    SvOK(sv)? "without a package or object reference"
                            : "on an undefined value");
+           }
            stash = gv_stashpvn(packname, packlen, TRUE);
            goto fetch;
        }

diff --git a/toke.c b/toke.c
index 8664b8f..e14ebfd 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).
@@ -167,9 +179,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);
@@ -476,7 +488,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;
@@ -552,7 +564,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 == '\'') )
     {
@@ -993,7 +1005,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
@@ -1249,7 +1261,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;
@@ -1856,16 +1868,8 @@ yylex(void)
   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:
@@ -2216,7 +2220,7 @@ yylex(void)
        else if (*s == '>') {
            s++;
            s = skipspace(s);
-           if (isIDFIRST(*s)) {
+           if (isIDFIRST_lazy(s)) {
                s = force_word(s,METHOD,FALSE,TRUE,FALSE);
                TOKEN(ARROW);
            }
@@ -2361,7 +2365,7 @@ yylex(void)
                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'))
@@ -2449,8 +2453,8 @@ yylex(void)
                    }
                    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++;
@@ -2460,7 +2464,7 @@ yylex(void)
                                   || (*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;
@@ -2508,7 +2512,7 @@ yylex(void)
            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++;
@@ -2638,7 +2642,7 @@ yylex(void)
            }
        }
 
-       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] = '@';
@@ -2679,7 +2683,7 @@ yylex(void)
                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);
@@ -2699,7 +2703,7 @@ yylex(void)
                    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,
@@ -2716,9 +2720,9 @@ yylex(void)
                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)) {
@@ -2776,7 +2780,7 @@ yylex(void)
            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++;
@@ -2797,7 +2801,7 @@ yylex(void)
            /* 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());
@@ -3110,7 +3114,7 @@ yylex(void)
 
                    /* 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,7 +3158,7 @@ yylex(void)
 
                /* 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) */
@@ -3468,13 +3472,13 @@ yylex(void)
        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);
@@ -3662,7 +3666,7 @@ yylex(void)
            TERM(sublex_start());
 
        case KEY_map:
-           LOP(OP_MAPSTART,XREF);
+           LOP(OP_MAPSTART, XREF);
            
        case KEY_mkdir:
            LOP(OP_MKDIR,XTERM);
@@ -3682,7 +3686,7 @@ yylex(void)
        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) {
@@ -3714,9 +3718,9 @@ yylex(void)
 
        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)",
@@ -3839,7 +3843,7 @@ yylex(void)
        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");
@@ -4023,7 +4027,7 @@ yylex(void)
          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);
@@ -4895,9 +4899,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++;
@@ -4990,9 +4994,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++;
@@ -5001,7 +5005,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);
@@ -5044,9 +5048,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++;
@@ -5055,7 +5059,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);
@@ -5077,7 +5081,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;
     }
@@ -5104,11 +5108,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);
@@ -5394,9 +5398,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;
        }
@@ -5577,7 +5581,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