[patch] GvSHARED

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

diff --git a/toke.c b/toke.c
index d2dd026..28c71ff 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -175,13 +175,13 @@ int yyactlevel = -1;
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
-void
-S_tokereport(char *thing, char* s, I32 rv)
+STATIC void
+S_tokereport(pTHX_ char *thing, char* s, I32 rv)
 { 
     SV *report;
     DEBUG_T({
         report = newSVpv(thing, 0);
-        sv_catpvf(report, ":line %i:%i:", CopLINE(PL_curcop), rv);
+        Perl_sv_catpvf(aTHX_ report, ":line %i:%i:", CopLINE(PL_curcop), rv);
 
         if (s - PL_bufptr > 0)
             sv_catpvn(report, PL_bufptr, s - PL_bufptr);
@@ -1388,8 +1388,7 @@ S_scan_const(pTHX_ char *start)
                               "Unrecognized escape \\%c passed through",
                               *s);
                    /* default action is to copy the quoted character */
-                   *d++ = *s++;
-                   continue;
+                   goto default_action;
                }
 
            /* \132 indicates an octal constant */
@@ -1479,6 +1478,13 @@ S_scan_const(pTHX_ char *start)
                     if (has_utf8 || uv > 255) {
                        d = (char*)uv_to_utf8((U8*)d, uv);
                        has_utf8 = TRUE;
+                       if (PL_lex_inwhat == OP_TRANS &&
+                           PL_sublex_info.sub_op) {
+                           PL_sublex_info.sub_op->op_private |=
+                               (PL_lex_repl ? OPpTRANS_FROM_UTF
+                                            : OPpTRANS_TO_UTF);
+                           utf = TRUE;
+                       }
                     }
                    else {
                        *d++ = (char)uv;
@@ -1506,6 +1512,8 @@ S_scan_const(pTHX_ char *start)
                    res = newSVpvn(s + 1, e - s - 1);
                    res = new_constant( Nullch, 0, "charnames",
                                        res, Nullsv, "\\N{...}" );
+                   if (has_utf8)
+                       sv_utf8_upgrade(res);
                    str = SvPV(res,len);
                    if (!has_utf8 && SvUTF8(res)) {
                        char *ostart = SvPVX(sv);
@@ -1588,8 +1596,7 @@ S_scan_const(pTHX_ char *start)
            continue;
        } /* end if (backslash) */
 
-       /* (now in tr/// code again) */
-
+    default_action:
        if (UTF8_IS_CONTINUED(*s) && (this_utf8 || has_utf8)) {
            STRLEN len = (STRLEN) -1;
            UV uv;
@@ -1608,10 +1615,15 @@ S_scan_const(pTHX_ char *start)
                    *d++ = *s++;
            }
            has_utf8 = TRUE;
+          if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
+              PL_sublex_info.sub_op->op_private |=
+                  (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
+              utf = TRUE;
+          }
            continue;
        }
 
-       *d++ = *s++;
+       *d++ = *s++;
     } /* while loop to process each character */
 
     /* terminate the string and set up the sv */
@@ -2560,7 +2572,32 @@ Perl_yylex(pTHX)
        }
        do {
            bof = PL_rsfp ? TRUE : FALSE;
-           if (bof) {
+           if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
+             fake_eof:
+               if (PL_rsfp) {
+                   if (PL_preprocess && !PL_in_eval)
+                       (void)PerlProc_pclose(PL_rsfp);
+                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
+                       PerlIO_clearerr(PL_rsfp);
+                   else
+                       (void)PerlIO_close(PL_rsfp);
+                   PL_rsfp = Nullfp;
+                   PL_doextract = FALSE;
+               }
+               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
+                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
+                   sv_catpv(PL_linestr,";}");
+                   PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+                   PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+                   PL_minus_n = PL_minus_p = 0;
+                   goto retry;
+               }
+               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               sv_setpv(PL_linestr,"");
+               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
+           }
+           /* if it looks like the start of a BOM, check if it in fact is */
+           else if (bof && (!*s || *(U8*)s == 0xEF || *(U8*)s >= 0xFE)) {
 #ifdef PERLIO_IS_STDIO
 #  ifdef __GNU_LIBRARY__
 #    if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
@@ -2580,38 +2617,14 @@ Perl_yylex(pTHX)
                 * Workaround?  Maybe attach some extra state to PL_rsfp?
                 */
                if (!PL_preprocess)
-                   bof = PerlIO_tell(PL_rsfp) == 0;
+                   bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #else
-               bof = PerlIO_tell(PL_rsfp) == 0;
+               bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #endif
-           }
-           s = filter_gets(PL_linestr, PL_rsfp, 0);
-           if (s == Nullch) {
-             fake_eof:
-               if (PL_rsfp) {
-                   if (PL_preprocess && !PL_in_eval)
-                       (void)PerlProc_pclose(PL_rsfp);
-                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
-                       PerlIO_clearerr(PL_rsfp);
-                   else
-                       (void)PerlIO_close(PL_rsfp);
-                   PL_rsfp = Nullfp;
-                   PL_doextract = FALSE;
-               }
-               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
-                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
-                   sv_catpv(PL_linestr,";}");
-                   PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-                   PL_minus_n = PL_minus_p = 0;
-                   goto retry;
+                   s = swallow_bom((U8*)s);
                }
-               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
-               sv_setpv(PL_linestr,"");
-               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
-           } else if (bof) {
-               PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-               s = swallow_bom((U8*)s);
            }
            if (PL_doextract) {
                if (*s == '#' && s[1] == '!' && instr(s,"perl"))
@@ -4157,10 +4170,6 @@ Perl_yylex(pTHX)
                        (void)PerlIO_seek(PL_rsfp, 0L, 0);
                    }
                    if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
-#if defined(__BORLANDC__)
-                       /* XXX see note in do_binmode() */
-                       ((FILE*)PL_rsfp)->flags |= _F_BIN;
-#endif
                        if (loc > 0)
                            PerlIO_seek(PL_rsfp, loc, 0);
                    }
@@ -4742,7 +4751,8 @@ Perl_yylex(pTHX)
        case KEY_qq:
        case KEY_qu:
            s = scan_str(s,FALSE,FALSE);
-           if (tmp == KEY_qu && is_utf8_string((U8*)s, SvCUR(PL_lex_stuff)))
+           if (tmp == KEY_qu &&
+               is_utf8_string((U8*)SvPVX(PL_lex_stuff), SvCUR(PL_lex_stuff)))
                SvUTF8_on(PL_lex_stuff);
            if (!s)
                missingterm((char*)0);