EBCDIC: the non-printable characters are different.

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

diff --git a/toke.c b/toke.c
index 6528ef4..2eb049f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1424,7 +1424,9 @@ S_scan_const(pTHX_ char *start)
                /* FALL THROUGH */
            default:
                {
-                   if (ckWARN(WARN_MISC) && isALNUM(*s))
+                   if (ckWARN(WARN_MISC) &&
+                       isALNUM(*s) && 
+                       *s != '_')
                        Perl_warner(aTHX_ WARN_MISC,
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1555,6 +1557,19 @@ S_scan_const(pTHX_ char *start)
                    if (has_utf8)
                        sv_utf8_upgrade(res);
                    str = SvPV(res,len);
+#ifdef EBCDIC
+                   {
+                        UV uv = utf8_to_uvchr((U8*)str, 0);
+
+                        if (uv < 0x100) {
+                             U8 tmpbuf[UTF8_MAXLEN+1], *d;
+
+                             d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
+                             sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
+                             str = SvPV(res, len);
+                        }
+                   }
+#endif
                    if (!has_utf8 && SvUTF8(res)) {
                        char *ostart = SvPVX(sv);
                        SvCUR_set(sv, d - ostart);
@@ -7579,7 +7594,7 @@ Perl_yyerror(pTHX_ char *s)
     }
     msg = sv_2mortal(newSVpv(s, 0));
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
-                  CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+        OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
        Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
     else
@@ -7597,10 +7612,10 @@ Perl_yyerror(pTHX_ char *s)
     if (PL_error_count >= 10) {
        if (PL_in_eval && SvCUR(ERRSV))
            Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
-                      ERRSV, CopFILE(PL_curcop));
+            ERRSV, OutCopFILE(PL_curcop));
        else
            Perl_croak(aTHX_ "%s has too many errors.\n",
-                      CopFILE(PL_curcop));
+            OutCopFILE(PL_curcop));
     }
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;