Integrate with Sarathy.

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

diff --git a/toke.c b/toke.c
index cbac39b..d1f77df 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -49,6 +49,13 @@ static void restore_lex_expect(pTHXo_ void *e);
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
+/* On MacOS, respect nonbreaking spaces */
+#ifdef MACOS_TRADITIONAL
+#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t')
+#else
+#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
+#endif
+
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
@@ -449,10 +456,11 @@ S_incline(pTHX_ char *s)
     char ch;
     int sawline = 0;
 
+    PERL_ASYNC_CHECK();
     PL_curcop->cop_line++;
     if (*s++ != '#')
        return;
-    while (*s == ' ' || *s == '\t') s++;
+    while (SPACE_OR_TAB(*s)) s++;
     if (strnEQ(s, "line ", 5)) {
        s += 5;
        sawline = 1;
@@ -462,7 +470,7 @@ S_incline(pTHX_ char *s)
     n = s;
     while (isDIGIT(*s))
        s++;
-    while (*s == ' ' || *s == '\t')
+    while (SPACE_OR_TAB(*s))
        s++;
     if (*s == '"' && (t = strchr(s+1, '"')))
        s++;
@@ -474,9 +482,9 @@ S_incline(pTHX_ char *s)
     ch = *t;
     *t = '\0';
     if (t - s > 0)
-       PL_curcop->cop_filegv = gv_fetchfile(s);
+       CopFILEGV_set(PL_curcop, gv_fetchfile(s));
     else
-       PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+       CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
     *t = ch;
     PL_curcop->cop_line = atoi(n)-1;
 }
@@ -492,7 +500,7 @@ S_skipspace(pTHX_ register char *s)
 {
     dTHR;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
-       while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+       while (s < PL_bufend && SPACE_OR_TAB(*s))
            s++;
        return s;
     }
@@ -590,7 +598,7 @@ S_skipspace(pTHX_ register char *s)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
-           av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+           av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
        }
     }
 }
@@ -2330,7 +2338,7 @@ Perl_yylex(pTHX)
 
                sv_upgrade(sv, SVt_PVMG);
                sv_setsv(sv,PL_linestr);
-               av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+               av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
            }
            goto retry;
        }
@@ -2379,7 +2387,7 @@ Perl_yylex(pTHX)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
-           av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+           av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
        }
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        if (PL_curcop->cop_line == 1) {
@@ -2420,7 +2428,7 @@ Perl_yylex(pTHX)
                     */
                    SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
                    assert(SvPOK(x) || SvGMAGICAL(x));
-                   if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
+                   if (sv_eq(x, CopFILESV(PL_curcop))) {
                        sv_setpvn(x, ipath, ipathend - ipath);
                        SvSETMAGIC(x);
                    }
@@ -2470,6 +2478,7 @@ Perl_yylex(pTHX)
                        *s = '#';       /* Don't try to parse shebang line */
                }
 #endif /* ALTERNATE_SHEBANG */
+#ifndef MACOS_TRADITIONAL
                if (!d &&
                    *s == '#' &&
                    ipathend > ipath &&
@@ -2497,13 +2506,14 @@ Perl_yylex(pTHX)
                    PerlProc_execv(ipath, newargv);
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
+#endif
                if (d) {
                    U32 oldpdb = PL_perldb;
                    bool oldn = PL_minus_n;
                    bool oldp = PL_minus_p;
 
                    while (*d && !isSPACE(*d)) d++;
-                   while (*d == ' ' || *d == '\t') d++;
+                   while (SPACE_OR_TAB(*d)) d++;
 
                    if (*d++ == '-') {
                        do {
@@ -2545,6 +2555,9 @@ Perl_yylex(pTHX)
       "(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
+#ifdef MACOS_TRADITIONAL
+    case '\312': /* Them nonbreaking spaces again */
+#endif
        s++;
        goto retry;
     case '#':
@@ -2573,7 +2586,7 @@ Perl_yylex(pTHX)
            PL_bufptr = s;
            tmp = *s++;
 
-           while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+           while (s < PL_bufend && SPACE_OR_TAB(*s))
                s++;
 
            if (strnEQ(s,"=>",2)) {
@@ -2839,20 +2852,20 @@ Perl_yylex(pTHX)
                PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
            OPERATOR(HASHBRACK);
        case XOPERATOR:
-           while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+           while (s < PL_bufend && SPACE_OR_TAB(*s))
                s++;
            d = s;
            PL_tokenbuf[0] = '\0';
            if (d < PL_bufend && *d == '-') {
                PL_tokenbuf[0] = '-';
                d++;
-               while (d < PL_bufend && (*d == ' ' || *d == '\t'))
+               while (d < PL_bufend && SPACE_OR_TAB(*d))
                    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'))
+               while (d < PL_bufend && SPACE_OR_TAB(*d))
                    d++;
                if (*d == '}') {
                    char minus = (PL_tokenbuf[0] == '-');
@@ -3063,9 +3076,9 @@ Perl_yylex(pTHX)
        if (PL_lex_brackets < PL_lex_formbrack) {
            char *t;
 #ifdef PERL_STRICT_CR
-           for (t = s; *t == ' ' || *t == '\t'; t++) ;
+           for (t = s; SPACE_OR_TAB(*t); t++) ;
 #else
-           for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+           for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
 #endif
            if (*t == '\n' || *t == '#') {
                s--;
@@ -3625,7 +3638,7 @@ Perl_yylex(pTHX)
                if (*s == '(') {
                    CLINE;
                    if (gv && GvCVu(gv)) {
-                       for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
+                       for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
                        if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
                            s = d + 1;
                            goto its_constant;
@@ -3724,7 +3737,7 @@ Perl_yylex(pTHX)
 
        case KEY___FILE__:
            yylval.opval = (OP*)newSVOP(OP_CONST, 0,
-                                       newSVsv(GvSV(PL_curcop->cop_filegv)));
+                                       newSVsv(CopFILESV(PL_curcop)));
            TERM(THING);
 
        case KEY___LINE__:
@@ -3776,6 +3789,7 @@ Perl_yylex(pTHX)
        case KEY_DESTROY:
        case KEY_BEGIN:
        case KEY_END:
+       case KEY_STOP:
        case KEY_INIT:
            if (PL_expect == XSTATE) {
                s = PL_bufptr;
@@ -5214,6 +5228,9 @@ 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;
@@ -5666,7 +5683,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
        if (isSPACE(s[-1])) {
            while (s < send) {
                char ch = *s++;
-               if (ch != ' ' && ch != '\t') {
+               if (!SPACE_OR_TAB(ch)) {
                    *d = ch;
                    break;
                }
@@ -5692,7 +5709,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
                    Perl_croak(aTHX_ ident_too_long);
            }
            *d = '\0';
-           while (s < send && (*s == ' ' || *s == '\t')) s++;
+           while (s < send && SPACE_OR_TAB(*s)) s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
                dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
@@ -5967,7 +5984,7 @@ S_scan_heredoc(pTHX_ register char *s)
     e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
     if (!outer)
        *d++ = '\n';
-    for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
+    for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
     if (*peek && strchr("`'\"",*peek)) {
        s = peek;
        term = *s++;
@@ -6115,8 +6132,7 @@ S_scan_heredoc(pTHX_ register char *s)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
-           av_store(GvAV(PL_curcop->cop_filegv),
-             (I32)PL_curcop->cop_line,sv);
+           av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line,sv);
        }
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            s = PL_bufend - 1;
@@ -6439,8 +6455,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
-           av_store(GvAV(PL_curcop->cop_filegv),
-             (I32)PL_curcop->cop_line, sv);
+           av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line, sv);
        }
 
        /* having changed the buffer, we must update PL_bufend */
@@ -6798,9 +6813,9 @@ S_scan_formline(pTHX_ register char *s)
        if (*s == '.' || *s == '}') {
            /*SUPPRESS 530*/
 #ifdef PERL_STRICT_CR
-           for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
+           for (t = s+1;SPACE_OR_TAB(*t); t++) ;
 #else
-           for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+           for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
 #endif
            if (*t == '\n' || t == PL_bufend)
                break;
@@ -6983,14 +6998,15 @@ Perl_yyerror(pTHX_ char *s)
     }
     msg = sv_2mortal(newSVpv(s, 0));
     Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
-              GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+                  CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
     if (context)
        Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
     else
        Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
-    if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
+    if (PL_multi_start < PL_multi_end &&
+       (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
         Perl_sv_catpvf(aTHX_ msg,
-        "  (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
+        "   (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
                 (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
         PL_multi_end = 0;
     }
@@ -6999,7 +7015,7 @@ Perl_yyerror(pTHX_ char *s)
     else
        qerror(msg);
     if (PL_error_count >= 10)
-       Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
+       Perl_croak(aTHX_ "%_ has too many errors.\n", CopFILESV(PL_curcop));
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;
     return 0;
@@ -7007,7 +7023,6 @@ Perl_yyerror(pTHX_ char *s)
 
 
 #ifdef PERL_OBJECT
-#define NO_XSLOCKS
 #include "XSUB.h"
 #endif