[inseparable changes from match from perl-5.003_97a to perl-5.003_97b]

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

diff --git a/toke.c b/toke.c
index ffc6329..c40955a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -622,7 +622,11 @@ sublex_start()
        return THING;
     }
     if (op_type == OP_CONST || op_type == OP_READLINE) {
-       yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
+       SV *sv = q(lex_stuff);
+       STRLEN len;
+       char *p = SvPV(sv, len);
+       yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len));
+       SvREFCNT_dec(sv);
        lex_stuff = Nullsv;
        return THING;
     }
@@ -1458,8 +1462,7 @@ yylex()
   retry:
     switch (*s) {
     default:
-       warn("Unrecognized character \\%03o ignored", *s++ & 255);
-       goto retry;
+       croak("Unrecognized character \\%03o", *s & 255);
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
@@ -1499,19 +1502,28 @@ yylex()
                    if (gv)
                        GvIMPORTED_AV_on(gv);
                    if (minus_F) {
-                       char tmpbuf1[50];
-                       if ( (splitstr[0] == '/'  || 
-                             splitstr[0] == '\'' || 
-                             splitstr[0] == '"'    ) &&
-                            strchr( splitstr+1, splitstr[0] ) )
-                           sprintf( tmpbuf1, "@F=split(%s);", splitstr );
+                       char *tmpbuf1;
+                       New(201, tmpbuf1, strlen(splitstr) * 2 + 20, char);
+                       if (strchr("/'\"", *splitstr)
+                             && strchr(splitstr + 1, *splitstr))
+                           sprintf(tmpbuf1, "@F=split(%s);", splitstr);
                        else {
+                           char delim;
                            s = "'~#\200\1'"; /* surely one char is unused...*/
                            while (s[1] && strchr(splitstr, *s))  s++;
-                           sprintf( tmpbuf1, "@F=split(%s%c%s%c);",
-                                    "q" + (*s == '\''), *s, splitstr, *s );
+                           delim = *s;
+                           sprintf(tmpbuf1, "@F=split(%s%c",
+                                   "q" + (delim == '\''), delim);
+                           d = tmpbuf1 + strlen(tmpbuf1);
+                           for (s = splitstr; *s; ) {
+                               if (*s == '\\')
+                                   *d++ = '\\';
+                               *d++ = *s++;
+                           }
+                           sprintf(d, "%c);", delim);
                        }
                        sv_catpv(linestr,tmpbuf1);
+                       Safefree(tmpbuf1);
                    }
                    else
                        sv_catpv(linestr,"@F=split(' ');");
@@ -1709,7 +1721,9 @@ yylex()
        }
        goto retry;
     case '\r':
-       croak("Illegal character \\%03o (carriage return)", '\r');
+       warn("Illegal character \\%03o (carriage return)", '\r');
+       croak(
+      "(Maybe you didn't strip carriage returns after a network transfer?)\n");
     case ' ': case '\t': case '\f': case 013:
        s++;
        goto retry;
@@ -2509,7 +2523,7 @@ yylex()
                        curcop->cop_line++;
                    }
                    else
-                       no_op("Bare word",s);
+                       no_op("Bareword",s);
                }
 
                /* Look for a subroutine with this name in current package. */
@@ -4374,7 +4388,12 @@ I32 ck_uni;
     }
     if (*s == '$' && s[1] &&
       (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
-       return s;
+    {
+       if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
+           deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
+       else
+           return s;
+    }
     if (*s == '{') {
        bracket = s;
        s++;
@@ -4575,7 +4594,8 @@ register PMOP *pm;
            }
        }
        /* promote the better string */
-       if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
+       if ((!pm->op_pmshort &&
+            !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
            ((pm->op_pmflags & PMf_SCANFIRST) &&
             (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
            SvREFCNT_dec(pm->op_pmshort);               /* ok if null */
@@ -5179,7 +5199,9 @@ char *s;
     char *context = NULL;
     int contlen = -1;
 
-    if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+    if (!yychar || (yychar == ';' && !rsfp))
+       where = "at EOF";
+    else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
        while (isSPACE(*oldoldbufptr))
            oldoldbufptr++;
@@ -5195,8 +5217,6 @@ char *s;
     }
     else if (yychar > 255)
        where = "next token ???";
-    else if (!yychar || (yychar == ';' && !rsfp))
-       where = "at EOF";
     else if ((yychar & 127) == 127) {
        if (lex_state == LEX_NORMAL ||
           (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))