perlport 1.30

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

diff --git a/toke.c b/toke.c
index 4058726..b5315fa 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11,8 +11,6 @@
  *   "It all comes from here, the stench and the peril."  --Frodo
  */
 
-#define TMP_CRLF_PATCH
-
 #include "EXTERN.h"
 #include "perl.h"
 
@@ -187,7 +185,13 @@ missingterm(char *s)
        if (nl)
            *nl = '\0';
     }
-    else if (PL_multi_close < 32 || PL_multi_close == 127) {
+    else if (
+#ifdef EBCDIC
+       iscntrl(PL_multi_close)
+#else
+       PL_multi_close < 32 || PL_multi_close == 127
+#endif
+       ) {
        *tmpbuf = '^';
        tmpbuf[1] = toCTRL(PL_multi_close);
        s = "\\n";
@@ -991,8 +995,15 @@ scan_const(char *start)
            /* \c is a control character */
            case 'c':
                s++;
+#ifdef EBCDIC
+               *d = *s++;
+               if (isLOWER(*d))
+                  *d = toUPPER(*d);
+               *d++ = toCTRL(*d); 
+#else
                len = *s++;
                *d++ = toCTRL(len);
+#endif
                continue;
 
            /* printf-style backslashes, formfeeds, newlines, etc */
@@ -1392,7 +1403,7 @@ filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
         else
            return Nullch ;
     }
-    else 
+    else
         return (sv_gets(sv, fp, append));
 }
 
@@ -1885,7 +1896,7 @@ yylex(void)
                     */
                    SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
                    assert(SvPOK(x) || SvGMAGICAL(x));
-                   if (sv_eq(x, GvSV(curcop->cop_filegv))) {
+                   if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
                        sv_setpvn(x, ipath, ipathend - ipath);
                        SvSETMAGIC(x);
                    }
@@ -1988,7 +1999,7 @@ yylex(void)
        }
        goto retry;
     case '\r':
-#ifndef TMP_CRLF_PATCH
+#ifdef PERL_STRICT_CR
        warn("Illegal character \\%03o (carriage return)", '\r');
        croak(
       "(Maybe you didn't strip carriage returns after a network transfer?)\n");
@@ -2857,8 +2868,8 @@ yylex(void)
                gv = Nullgv;
                gvp = 0;
                if (PL_dowarn && hgv)
-                   warn("Ambiguous call resolved as CORE::%s(), "
-                        "qualify as such or use &", GvENAME(hgv));
+                   warn("Ambiguous call resolved as CORE::%s(), %s",
+                        GvENAME(hgv), "qualify as such or use &");
            }
        }
 
@@ -3197,7 +3208,7 @@ yylex(void)
 
        case KEY_crypt:
 #ifdef FCRYPT
-           if (!cryptseen++)
+           if (!PL_cryptseen++)
                init_des();
 #endif
            LOP(OP_CRYPT,XTERM);
@@ -4059,7 +4070,17 @@ yylex(void)
            FUN0(OP_WANTARRAY);
 
        case KEY_write:
-           gv_fetchpv("\f",TRUE, SVt_PV);      /* Make sure $^L is defined */
+#ifdef EBCDIC
+       {
+           static char ctl_l[2];
+
+           if (ctl_l[0] == '\0') 
+               ctl_l[0] = toCTRL('L');
+           gv_fetchpv(ctl_l,TRUE, SVt_PV);
+       }
+#else
+           gv_fetchpv("\f",TRUE, SVt_PV);      /* Make sure $^L is defined */
+#endif
            UNI(OP_ENTERWRITE);
 
        case KEY_x:
@@ -5168,7 +5189,7 @@ scan_heredoc(register char *s)
     *d++ = '\n';
     *d = '\0';
     len = d - PL_tokenbuf;
-#ifdef TMP_CRLF_PATCH
+#ifndef PERL_STRICT_CR
     d = strchr(s, '\r');
     if (d) {
        char *olds = s;
@@ -5244,9 +5265,11 @@ scan_heredoc(register char *s)
        }
        PL_curcop->cop_line++;
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-#ifdef TMP_CRLF_PATCH
+#ifndef PERL_STRICT_CR
        if (PL_bufend - PL_linestart >= 2) {
-           if (PL_bufend[-2] == '\r' || PL_bufend[-2] == '\n') {
+           if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
+               (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
+           {
                PL_bufend[-2] = '\n';
                PL_bufend--;
                SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
@@ -5541,9 +5564,11 @@ scan_str(char *start)
 
        if (s < PL_bufend) break;       /* handle case where we are done yet :-) */
 
-#ifdef TMP_CRLF_PATCH
+#ifndef PERL_STRICT_CR
        if (to - SvPVX(sv) >= 2) {
-           if (to[-2] == '\r' || to[-2] == '\n') {
+           if ((to[-2] == '\r' && to[-1] == '\n') ||
+               (to[-2] == '\n' && to[-1] == '\r'))
+           {
                to[-2] = '\n';
                to--;
                SvCUR_set(sv, to - SvPVX(sv));