Maintenance 5.004_04 changes

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

diff --git a/toke.c b/toke.c
index f443af7..b2e8aac 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -66,6 +66,8 @@ static struct {
  * can get by with a single comparison (if the compiler is smart enough).
  */
 
+/* #define LEX_NOTPARSING              11 is done in perl.h. */
+
 #define LEX_NORMAL             10
 #define LEX_INTERPNORMAL        9
 #define LEX_INTERPCASEMOD       8
@@ -385,6 +387,8 @@ register char *s;
                PerlIO_clearerr(rsfp);
            else
                (void)PerlIO_close(rsfp);
+           if (e_fp == rsfp)
+               e_fp = Nullfp;
            rsfp = Nullfp;
            return s;
        }
@@ -392,7 +396,7 @@ register char *s;
        bufend = s + SvCUR(linestr);
        s = bufptr;
        incline(s);
-       if (perldb && curstash != debstash) {
+       if (PERLDB_LINE && curstash != debstash) {
            SV *sv = NEWSV(85,0);
 
            sv_upgrade(sv, SVt_PVMG);
@@ -1526,7 +1530,7 @@ yylex()
            sv_catpv(linestr, "\n");
            oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
            bufend = SvPVX(linestr) + SvCUR(linestr);
-           if (perldb && curstash != debstash) {
+           if (PERLDB_LINE && curstash != debstash) {
                SV *sv = NEWSV(85,0);
 
                sv_upgrade(sv, SVt_PVMG);
@@ -1545,6 +1549,8 @@ yylex()
                        PerlIO_clearerr(rsfp);
                    else
                        (void)PerlIO_close(rsfp);
+                   if (e_fp == rsfp)
+                       e_fp = Nullfp;
                    rsfp = Nullfp;
                }
                if (!in_eval && (minus_n || minus_p)) {
@@ -1574,7 +1580,7 @@ yylex()
            incline(s);
        } while (doextract);
        oldoldbufptr = oldbufptr = bufptr = linestart = s;
-       if (perldb && curstash != debstash) {
+       if (PERLDB_LINE && curstash != debstash) {
            SV *sv = NEWSV(85,0);
 
            sv_upgrade(sv, SVt_PVMG);
@@ -1699,7 +1705,7 @@ yylex()
                            }
                            d = moreswitches(d);
                        } while (d);
-                       if (perldb && !oldpdb ||
+                       if (PERLDB_LINE && !oldpdb ||
                            ( minus_n || minus_p ) && !(oldn || oldp) )
                              /* if we have already added "LINE: while (<>) {",
                                 we must not do it again */
@@ -1708,7 +1714,7 @@ yylex()
                            oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
                            bufend = SvPVX(linestr) + SvCUR(linestr);
                            preambled = FALSE;
-                           if (perldb)
+                           if (PERLDB_LINE)
                                (void)gv_fetchfile(origfilename);
                            goto retry;
                        }
@@ -2033,16 +2039,16 @@ yylex()
                        close = term;
                        if (open == close)
                            for (t++; t < bufend; t++) {
-                               if (*t == '\\' && t+1 < bufend && term != '\\')
+                               if (*t == '\\' && t+1 < bufend && open != '\\')
                                    t++;
-                               else if (*t == term)
+                               else if (*t == open)
                                    break;
                            }
                        else
                            for (t++; t < bufend; t++) {
-                               if (*t == '\\' && t+1 < bufend && term != '\\')
+                               if (*t == '\\' && t+1 < bufend)
                                    t++;
-                               else if (*t == term && --brackets <= 0)
+                               else if (*t == close && --brackets <= 0)
                                    break;
                                else if (*t == open)
                                    brackets++;
@@ -2316,8 +2322,23 @@ yylex()
            else if (isIDFIRST(*s)) {
                char tmpbuf[sizeof tokenbuf];
                scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
-               if (keyword(tmpbuf, len))
-                   expect = XTERM;     /* e.g. print $fh length() */
+               if (tmp = keyword(tmpbuf, len)) {
+                   /* binary operators exclude handle interpretations */
+                   switch (tmp) {
+                   case -KEY_x:
+                   case -KEY_eq:
+                   case -KEY_ne:
+                   case -KEY_gt:
+                   case -KEY_lt:
+                   case -KEY_ge:
+                   case -KEY_le:
+                   case -KEY_cmp:
+                       break;
+                   default:
+                       expect = XTERM; /* e.g. print $fh length() */
+                       break;
+                   }
+               }
                else {
                    GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
                    if (gv && GvCVu(gv))
@@ -3954,7 +3975,7 @@ I32 len;
        case 4:
            if (strEQ(d,"grep"))                return KEY_grep;
            if (strEQ(d,"goto"))                return KEY_goto;
-           if (strEQ(d,"glob"))                return -KEY_glob;
+           if (strEQ(d,"glob"))                return KEY_glob;
            break;
        case 6:
            if (strEQ(d,"gmtime"))              return -KEY_gmtime;
@@ -4515,7 +4536,7 @@ I32 ck_uni;
                lex_state = LEX_INTERPEND;
            if (funny == '#')
                funny = '@';
-           if (dowarn &&
+           if (dowarn && lex_state == LEX_NORMAL &&
              (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
                warn("Ambiguous use of %c{%s} resolved to %c%s",
                    funny, dest, funny, dest);
@@ -4831,7 +4852,7 @@ register char *s;
            missingterm(tokenbuf);
        }
        curcop->cop_line++;
-       if (perldb && curstash != debstash) {
+       if (PERLDB_LINE && curstash != debstash) {
            SV *sv = NEWSV(88,0);
 
            sv_upgrade(sv, SVt_PVMG);
@@ -4968,13 +4989,13 @@ char *start;
            for (; s < bufend; s++,to++) {
                if (*s == '\n' && !rsfp)
                    curcop->cop_line++;
-               if (*s == '\\' && s+1 < bufend && term != '\\') {
-                   if (s[1] == term)
+               if (*s == '\\' && s+1 < bufend) {
+                   if ((s[1] == multi_open) || (s[1] == multi_close))
                        s++;
                    else
                        *to++ = *s++;
                }
-               else if (*s == term && --brackets <= 0)
+               else if (*s == multi_close && --brackets <= 0)
                    break;
                else if (*s == multi_open)
                    brackets++;
@@ -4993,7 +5014,7 @@ char *start;
            return Nullch;
        }
        curcop->cop_line++;
-       if (perldb && curstash != debstash) {
+       if (PERLDB_LINE && curstash != debstash) {
            SV *sv = NEWSV(88,0);
 
            sv_upgrade(sv, SVt_PVMG);