Re: Possible precedence problem on bitwise ^ operator

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 6b27a37..4d694cd 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,7 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -2141,7 +2142,7 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 #ifdef DEBUGGING
     static char* exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
-         "ATTRTERM", "TERMBLOCK"
+         "ATTRTERM", "TERMBLOCK", "TERMORDORDOR"
        };
 #endif
 
@@ -2939,8 +2940,6 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '%';
        s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
        if (!PL_tokenbuf[1]) {
-           if (s == PL_bufend)
-               yyerror("Final % should be \\% or %name");
            PREREF('%');
        }
        PL_pending_ident = '%';
@@ -3025,6 +3024,8 @@ Perl_yylex(pTHX)
                        CvLOCKED_on(PL_compcv);
                    else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
                        CvMETHOD_on(PL_compcv);
+                   else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len))
+                       CvASSERTION_on(PL_compcv);
 #ifdef USE_ITHREADS
                    else if (PL_in_my == KEY_our && len == 6 &&
                             strnEQ(s, "unique", len))
@@ -3086,6 +3087,7 @@ Perl_yylex(pTHX)
            PL_oldbufptr = PL_oldoldbufptr;             /* allow print(STDOUT 123) */
        else
            PL_expect = XTERM;
+       s = skipspace(s);
        TOKEN('(');
     case ';':
        CLINE;
@@ -3207,12 +3209,17 @@ Perl_yylex(pTHX)
                            || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
                                && !isALNUM(*t))))
                    {
+                       /* skip q//-like construct */
                        char *tmps;
                        char open, close, term;
                        I32 brackets = 1;
 
                        while (t < PL_bufend && isSPACE(*t))
                            t++;
+                       /* check for q => */
+                       if (t+1 < PL_bufend && t[0] == '=' && t[1] == '>') {
+                           OPERATOR(HASHBRACK);
+                       }
                        term = *t;
                        open = term;
                        if (term && (tmps = strchr("([{< )]}> )]}>",term)))
@@ -3225,7 +3232,7 @@ Perl_yylex(pTHX)
                                else if (*t == open)
                                    break;
                            }
-                       else
+                       else {
                            for (t++; t < PL_bufend; t++) {
                                if (*t == '\\' && t+1 < PL_bufend)
                                    t++;
@@ -3234,8 +3241,13 @@ Perl_yylex(pTHX)
                                else if (*t == open)
                                    brackets++;
                            }
+                       }
+                       t++;
                    }
-                   t++;
+                   else
+                       /* skip plain q word */
+                       while (t < PL_bufend && isALNUM_lazy_if(t,UTF))
+                            t += UTF8SKIP(t);
                }
                else if (isALNUM_lazy_if(t,UTF)) {
                    t += UTF8SKIP(t);
@@ -3561,8 +3573,6 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '@';
        s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
        if (!PL_tokenbuf[1]) {
-           if (s == PL_bufend)
-               yyerror("Final @ should be \\@ or @name");
            PREREF('@');
        }
        if (PL_lex_state == LEX_NORMAL)
@@ -4072,6 +4082,8 @@ Perl_yylex(pTHX)
                            TERM(FUNC0SUB);
                        if (strEQ(proto, "$"))
                            OPERATOR(UNIOPSUB);
+                       while (*proto == ';')
+                           proto++;
                        if (*proto == '&' && *s == '{') {
                            sv_setpv(PL_subname, PL_curstash ? 
                                        "__ANON__" : "__ANON__::__ANON__");
@@ -4186,8 +4198,29 @@ Perl_yylex(pTHX)
                }
 #endif
 #ifdef PERLIO_LAYERS
-               if (UTF && !IN_BYTES)
-                   PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
+               if (!IN_BYTES) {
+                   if (UTF)
+                       PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
+                   else if (PL_encoding) {
+                       SV *name;
+                       dSP;
+                       ENTER;
+                       SAVETMPS;
+                       PUSHMARK(sp);
+                       EXTEND(SP, 1);
+                       XPUSHs(PL_encoding);
+                       PUTBACK;
+                       call_method("name", G_SCALAR);
+                       SPAGAIN;
+                       name = POPs;
+                       PUTBACK;
+                       PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, 
+                                           Perl_form(aTHX_ ":encoding(%"SVf")",
+                                                     name));
+                       FREETMPS;
+                       LEAVE;
+                   }
+               }
 #endif
                PL_rsfp = Nullfp;
            }
@@ -5239,7 +5272,7 @@ static int
 S_pending_ident(pTHX)
 {
     register char *d;
-    register I32 tmp;
+    register I32 tmp = 0;
     /* pit holds the identifier we read and pending_ident is reset */
     char pit = PL_pending_ident;
     PL_pending_ident = 0;
@@ -6274,8 +6307,10 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
        }
        if (*s == '}') {
            s++;
-           if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets)
+           if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
                PL_lex_state = LEX_INTERPEND;
+               PL_expect = XREF;
+           }
            if (funny == '#')
                funny = '@';
            if (PL_lex_state == LEX_NORMAL) {
@@ -6662,8 +6697,12 @@ retval:
        Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
     }
     SvREFCNT_dec(herewas);
-    if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
-       SvUTF8_on(tmpstr);
+    if (!IN_BYTES) {
+       if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+           SvUTF8_on(tmpstr);
+       else if (PL_encoding)
+           sv_recode_to_utf8(tmpstr, PL_encoding);
+    }
     PL_lex_stuff = tmpstr;
     yylval.ival = op_type;
     return s;
@@ -6901,7 +6940,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        termlen = 1;
     }
     else {
-       termcode = utf8_to_uvchr(s, &termlen);
+       termcode = utf8_to_uvchr((U8*)s, &termlen);
        Copy(s, termstr, termlen, U8);
        if (!UTF8_IS_INVARIANT(term))
            has_utf8 = TRUE;
@@ -6935,7 +6974,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
            while (cont) {
                int offset = s - SvPVX(PL_linestr);
                bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
-                                          &offset, termstr, termlen);
+                                          &offset, (char*)termstr, termlen);
                char *ns = SvPVX(PL_linestr) + offset;
                char *svlast = SvEND(sv) - 1;
 
@@ -7023,7 +7062,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                else if (*s == term) {
                    if (termlen == 1)
                        break;
-                   if (s+termlen <= PL_bufend && memEQ(s, termstr, termlen))
+                   if (s+termlen <= PL_bufend && memEQ(s, (char*)termstr, termlen))
                        break;
                }
                else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
@@ -7613,6 +7652,12 @@ S_scan_formline(pTHX_ register char *s)
        }
        else
            PL_lex_state = LEX_FORMLINE;
+       if (!IN_BYTES) {
+           if (UTF && is_utf8_string((U8*)SvPVX(stuff), SvCUR(stuff)))
+               SvUTF8_on(stuff);
+           else if (PL_encoding)
+               sv_recode_to_utf8(stuff, PL_encoding);
+       }
        PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
        force_next(THING);
        PL_nextval[PL_nexttoke].ival = OP_FORMLINE;