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

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

diff --git a/toke.c b/toke.c
index d1c60dd..6a306ec 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,14 +1502,28 @@ yylex()
                    if (gv)
                        GvIMPORTED_AV_on(gv);
                    if (minus_F) {
-                       char tmpbuf1[50];
-                       if ( splitstr[0] == '/' || 
-                            splitstr[0] == '\'' || 
-                            splitstr[0] == '"' )
-                           sprintf( tmpbuf1, "@F=split(%s);", splitstr );
-                       else
-                           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++;
+                           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(' ');");
@@ -1679,7 +1696,15 @@ yylex()
                    while (*d == ' ' || *d == '\t') d++;
 
                    if (*d++ == '-') {
-                       while (d = moreswitches(d)) ;
+                       do {
+                           if (*d == 'M' || *d == 'm') {
+                               char *m = d;
+                               while (*d && !isSPACE(*d)) d++;
+                               croak("Too late for \"-%.*s\" option",
+                                     (int)(d - m), m);
+                           }
+                           d = moreswitches(d);
+                       } while (d);
                        if (perldb && !oldpdb ||
                            ( minus_n || minus_p ) && !(oldn || oldp) )
                              /* if we have already added "LINE: while (<>) {",
@@ -1704,7 +1729,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;
@@ -2504,7 +2531,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. */
@@ -4369,7 +4396,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++;
@@ -4570,7 +4602,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 */
@@ -5174,7 +5207,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++;
@@ -5190,8 +5225,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))