projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
Update Changes.
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 2e862b4..7cd0983 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -41,11 +41,7 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #ifdef USE_UTF8_SCRIPTS
 #   define UTF (!IN_BYTES)
 #else
-#   ifdef EBCDIC /* For now 'use utf8' does not affect tokenizer on EBCDIC */
-#       define UTF (PL_linestr && DO_UTF8(PL_linestr))
-#   else
-#       define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
-#   endif
+#   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
 /* In variables named $^X, these are the legal values for X.
@@ -302,7 +298,7 @@ S_missingterm(pTHX_ char *s)
        s = tmpbuf;
     }
     else {
-       *tmpbuf = PL_multi_close;
+       *tmpbuf = (char)PL_multi_close;
        tmpbuf[1] = '\0';
        s = tmpbuf;
     }
@@ -711,7 +707,7 @@ S_lop(pTHX_ I32 f, int x, char *s)
     PL_expect = x;
     PL_bufptr = s;
     PL_last_lop = PL_oldbufptr;
-    PL_last_lop_op = f;
+    PL_last_lop_op = (OPCODE)f;
     if (PL_nexttoke)
        return LSTOP;
     if (*s == '(')
@@ -1069,7 +1065,7 @@ S_sublex_push(pTHX)
     *PL_lex_casestack = '\0';
     PL_lex_starts = 0;
     PL_lex_state = LEX_INTERPCONCAT;
-    CopLINE_set(PL_curcop, PL_multi_start);
+    CopLINE_set(PL_curcop, (line_t)PL_multi_start);
 
     PL_lex_inwhat = PL_sublex_info.sub_inwhat;
     if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
@@ -1288,7 +1284,7 @@ S_scan_const(pTHX_ char *start)
                else
 #endif
                    for (i = min; i <= max; i++)
-                       *d++ = i;
+                       *d++ = (char)i;
 
                /* mark the range as done, and continue */
                dorange = FALSE;
@@ -1496,8 +1492,8 @@ S_scan_const(pTHX_ char *start)
                            while (src >= (U8 *)SvPVX(sv)) {
                                if (!NATIVE_IS_INVARIANT(*src)) {
                                    U8 ch = NATIVE_TO_ASCII(*src);
-                                   *dst-- = UTF8_EIGHT_BIT_LO(ch);
-                                   *dst-- = UTF8_EIGHT_BIT_HI(ch);
+                                   *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
+                                   *dst-- = (U8)UTF8_EIGHT_BIT_HI(ch);
                                }
                                else {
                                    *dst-- = *src;
@@ -1540,6 +1536,16 @@ S_scan_const(pTHX_ char *start)
                        e = s - 1;
                        goto cont_scan;
                    }
+                   if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
+                       /* \N{U+...} */
+                       I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
+                         PERL_SCAN_DISALLOW_PREFIX;
+                       s += 3;
+                       len = e - s;
+                       uv = grok_hex(s, &len, &flags, NULL);
+                       s = e + 1;
+                       goto NUM_ESCAPE_INSERT;
+                   }
                    res = newSVpvn(s + 1, e - s - 1);
                    res = new_constant( Nullch, 0, "charnames",
                                        res, Nullsv, "\\N{...}" );
@@ -1573,11 +1579,11 @@ S_scan_const(pTHX_ char *start)
                        *d = '\0';
                        sv_utf8_upgrade(sv);
                        /* this just broke our allocation above... */
-                       SvGROW(sv, send - start);
+                       SvGROW(sv, (STRLEN)(send - start));
                        d = SvPVX(sv) + SvCUR(sv);
                        has_utf8 = TRUE;
                    }
-                   if (len > e - s + 4) { /* I _guess_ 4 is \N{} --jhi */
+                   if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
                        char *odest = SvPVX(sv);
 
                        SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
@@ -2039,7 +2045,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
            int old_len = SvCUR(buf_sv) ;
 
            /* ensure buf_sv is large enough */
-           SvGROW(buf_sv, old_len + maxlen) ;
+           SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ;
            if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
                if (PerlIO_error(PL_rsfp))
                    return -1;          /* error */
@@ -2251,7 +2257,7 @@ Perl_yylex(pTHX)
               "### Saw case modifier at '%s'\n", PL_bufptr); });
            s = PL_bufptr + 1;
            if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
-               tmp = *s, *s = s[2], s[2] = tmp;        /* misordered... */
+               tmp = *s, *s = s[2], s[2] = (char)tmp;  /* misordered... */
            if (strchr("LU", *s) &&
                (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
            {
@@ -2535,7 +2541,7 @@ Perl_yylex(pTHX)
                if (!PL_preprocess)
                    bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #else
-               bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
+               bof = PerlIO_tell(PL_rsfp) == (Off_t)SvCUR(PL_linestr);
 #endif
                if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -2830,7 +2836,7 @@ Perl_yylex(pTHX)
                break;
            }
            if (ftst) {
-               PL_last_lop_op = ftst;
+               PL_last_lop_op = (OPCODE)ftst;
                DEBUG_T( { PerlIO_printf(Perl_debug_log,
                         "### Saw file test %c\n", (int)ftst);
                } );
@@ -4041,7 +4047,7 @@ Perl_yylex(pTHX)
                    if (ckWARN(WARN_RESERVED)) {
                        if (lastchar != '-') {
                            for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
-                           if (!*d && strNE(PL_tokenbuf,"main"))
+                           if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
                                Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
                                       PL_tokenbuf);
                        }
@@ -6247,7 +6253,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 }
 
 void
-Perl_pmflag(pTHX_ U16 *pmfl, int ch)
+Perl_pmflag(pTHX_ U32* pmfl, int ch)
 {
     if (ch == 'i')
        *pmfl |= PMf_FOLD;
@@ -6523,7 +6529,7 @@ S_scan_heredoc(pTHX_ register char *s)
                CopLINE_inc(PL_curcop);
        }
        if (s >= bufend) {
-           CopLINE_set(PL_curcop, PL_multi_start);
+           CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            missingterm(PL_tokenbuf);
        }
        sv_setpvn(herewas,bufptr,d-bufptr+1);
@@ -6543,7 +6549,7 @@ S_scan_heredoc(pTHX_ register char *s)
                CopLINE_inc(PL_curcop);
        }
        if (s >= PL_bufend) {
-           CopLINE_set(PL_curcop, PL_multi_start);
+           CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            missingterm(PL_tokenbuf);
        }
        sv_setpvn(tmpstr,d+1,s-d);
@@ -6561,7 +6567,7 @@ S_scan_heredoc(pTHX_ register char *s)
     while (s >= PL_bufend) {   /* multiple line string? */
        if (!outer ||
         !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
-           CopLINE_set(PL_curcop, PL_multi_start);
+           CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            missingterm(PL_tokenbuf);
        }
        CopLINE_inc(PL_curcop);
@@ -6954,7 +6960,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        if (!PL_rsfp ||
         !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
            sv_free(sv);
-           CopLINE_set(PL_curcop, PL_multi_start);
+           CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            return Nullch;
        }
        /* we read a line, so increment our line counter */
@@ -7571,15 +7577,33 @@ Perl_yyerror(pTHX_ char *s)
        where = "at EOF";
     else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 &&
       PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
+       /*
+               Only for NetWare:
+               The code below is removed for NetWare because it abends/crashes on NetWare
+               when the script has error such as not having the closing quotes like:
+                   if ($var eq "value)
+               Checking of white spaces is anyway done in NetWare code.
+       */
+#ifndef NETWARE
        while (isSPACE(*PL_oldoldbufptr))
            PL_oldoldbufptr++;
+#endif
        context = PL_oldoldbufptr;
        contlen = PL_bufptr - PL_oldoldbufptr;
     }
     else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
       PL_oldbufptr != PL_bufptr) {
+       /*
+               Only for NetWare:
+               The code below is removed for NetWare because it abends/crashes on NetWare
+               when the script has error such as not having the closing quotes like:
+                   if ($var eq "value)
+               Checking of white spaces is anyway done in NetWare code.
+       */
+#ifndef NETWARE
        while (isSPACE(*PL_oldbufptr))
            PL_oldbufptr++;
+#endif
        context = PL_oldbufptr;
        contlen = PL_bufptr - PL_oldbufptr;
     }
Unnamed repository; edit this file to name it for gitweb.