Integrate with Sarathy.

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

diff --git a/toke.c b/toke.c
index f35a042..e7e2174 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -495,8 +495,6 @@ S_incline(pTHX_ char *s)
     *t = '\0';
     if (t - s > 0)
        CopFILE_set(PL_curcop, s);
-    else
-       CopFILE_set(PL_curcop, PL_origfilename);
     *t = ch;
     CopLINE_set(PL_curcop, atoi(n)-1);
 }
@@ -1384,7 +1382,7 @@ S_scan_const(pTHX_ char *start)
                            if (ckWARN(WARN_UTF8))
                                Perl_warner(aTHX_ WARN_UTF8,
                                    "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
-                                   len,s,len,s);
+                                   (int)len,s,(int)len,s);
                        }
                        *d++ = (char)uv;
                    }
@@ -1978,6 +1976,10 @@ Perl_yylex(pTHX)
        */
        if (PL_in_my) {
            if (PL_in_my == KEY_our) {  /* "our" is merely analogous to "my" */
+               if (strchr(PL_tokenbuf,':'))
+                   yyerror(Perl_form(aTHX_ "No package name allowed for "
+                                     "variable %s in \"our\"",
+                                     PL_tokenbuf));
                tmp = pad_allocmy(PL_tokenbuf);
            }
            else {
@@ -2015,15 +2017,19 @@ Perl_yylex(pTHX)
            }
 #endif /* USE_THREADS */
            if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
+               SV *namesv = AvARRAY(PL_comppad_name)[tmp];
                /* might be an "our" variable" */
-               if (SvFLAGS(AvARRAY(PL_comppad_name)[tmp]) & SVpad_OUR) {
+               if (SvFLAGS(namesv) & SVpad_OUR) {
                    /* build ops for a bareword */
-                   yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
+                   SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0);
+                   sv_catpvn(sym, "::", 2);
+                   sv_catpv(sym, PL_tokenbuf+1);
+                   yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                    yylval.opval->op_private = OPpCONST_ENTERED;
-                   gv_fetchpv(PL_tokenbuf+1,
+                   gv_fetchpv(SvPVX(sym),
                        (PL_in_eval
-                           ? (GV_ADDMULTI | GV_ADDINEVAL | GV_ADDOUR)
-                           : GV_ADDOUR
+                           ? (GV_ADDMULTI | GV_ADDINEVAL)
+                           : TRUE
                        ),
                        ((PL_tokenbuf[0] == '$') ? SVt_PV
                         : (PL_tokenbuf[0] == '@') ? SVt_PVAV
@@ -2745,6 +2751,21 @@ Perl_yylex(pTHX)
            attrs = Nullop;
            while (isIDFIRST_lazy(s)) {
                d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+               if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
+                   if (tmp < 0) tmp = -tmp;
+                   switch (tmp) {
+                   case KEY_or:
+                   case KEY_and:
+                   case KEY_for:
+                   case KEY_unless:
+                   case KEY_if:
+                   case KEY_while:
+                   case KEY_until:
+                       goto got_attrs;
+                   default:
+                       break;
+                   }
+               }
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
@@ -2776,11 +2797,13 @@ Perl_yylex(pTHX)
                                                newSVpvn(s, len)));
                }
                s = skipspace(d);
-               while (*s == ',')
+               if (*s == ':' && s[1] != ':')
                    s = skipspace(s+1);
+               else if (s == d)
+                   break;      /* require real whitespace or :'s */
            }
-           tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}' for vi */
-           if (*s != ';' && *s != tmp) {
+           tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */
+           if (*s != ';' && *s != tmp && (tmp != '=' || *s != ')')) {
                char q = ((*s == '\'') ? '"' : '\'');
                /* If here for an expression, and parsed no attrs, back off. */
                if (tmp == '=' && !attrs) {
@@ -2800,6 +2823,7 @@ Perl_yylex(pTHX)
                    op_free(attrs);
                OPERATOR(':');
            }
+       got_attrs:
            if (attrs) {
                PL_nextval[PL_nexttoke].opval = attrs;
                force_next(THING);
@@ -3836,9 +3860,9 @@ Perl_yylex(pTHX)
        case KEY_AUTOLOAD:
        case KEY_DESTROY:
        case KEY_BEGIN:
-       case KEY_END:
-       case KEY_STOP:
+       case KEY_CHECK:
        case KEY_INIT:
+       case KEY_END:
            if (PL_expect == XSTATE) {
                s = PL_bufptr;
                goto really_sub;
@@ -4062,7 +4086,7 @@ Perl_yylex(pTHX)
            Rop(OP_SGE);
 
        case KEY_grep:
-           LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
+           LOP(OP_GREPSTART, XREF);
 
        case KEY_goto:
            s = force_word(s,WORD,TRUE,FALSE,FALSE);
@@ -4224,7 +4248,7 @@ Perl_yylex(pTHX)
            TERM(sublex_start());
 
        case KEY_map:
-           LOP(OP_MAPSTART, *s == '(' ? XTERM : XREF);
+           LOP(OP_MAPSTART, XREF);
 
        case KEY_mkdir:
            LOP(OP_MKDIR,XTERM);
@@ -4899,6 +4923,7 @@ Perl_keyword(pTHX_ register char *d, I32 len)
        break;
     case 'C':
        if (strEQ(d,"CORE"))                    return -KEY_CORE;
+       if (strEQ(d,"CHECK"))                   return KEY_CHECK;
        break;
     case 'c':
        switch (len) {
@@ -5282,9 +5307,6 @@ Perl_keyword(pTHX_ register char *d, I32 len)
            break;
        }
        break;
-    case 'S':
-       if (strEQ(d,"STOP"))                    return KEY_STOP;
-       break;
     case 's':
        switch (d[1]) {
        case 0:                                 return KEY_s;
@@ -7118,7 +7140,7 @@ Perl_yyerror(pTHX_ char *s)
         PL_multi_end = 0;
     }
     if (PL_in_eval & EVAL_WARNONLY)
-       Perl_warn(aTHX_ "%_", msg);
+       Perl_warn(aTHX_ "%"SVf, msg);
     else
        qerror(msg);
     if (PL_error_count >= 10)