INSTALL patches

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

diff --git a/toke.c b/toke.c
index f1aca91..4803bc8 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, 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.
@@ -363,7 +363,7 @@ lex_start(SV *line)
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
     SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpv("\n", 1);
+    PL_rs = newSVpvn("\n", 1);
     PL_rsfp = 0;
 }
 
@@ -683,7 +683,7 @@ tokeq(SV *sv)
        goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING )
-       pv = sv_2mortal(newSVpv(SvPVX(pv), len));
+       pv = sv_2mortal(newSVpvn(SvPVX(pv), len));
     while (s < send) {
        if (*s == '\\') {
            if (s + 1 < send && (s[1] == '\\'))
@@ -719,7 +719,7 @@ sublex_start(void)
            SV *nsv;
 
            p = SvPV(sv, len);
-           nsv = newSVpv(p, len);
+           nsv = newSVpvn(p, len);
            SvREFCNT_dec(sv);
            sv = nsv;
        } 
@@ -801,7 +801,7 @@ sublex_done(void)
 {
     if (!PL_lex_starts++) {
        PL_expect = XOPERATOR;
-       yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
+       yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
        return THING;
     }
 
@@ -1411,7 +1411,7 @@ intuit_method(char *start, GV *gv)
                return 0;       /* no assumptions -- "=>" quotes bearword */
       bare_package:
            PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
-                                                  newSVpv(tmpbuf,0));
+                                                  newSVpvn(tmpbuf,len));
            PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
            PL_expect = XTERM;
            force_next(WORD);
@@ -1638,7 +1638,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
        */
        if (PL_in_my) {
            if (strchr(PL_tokenbuf,':'))
-               croak(PL_no_myglob,PL_tokenbuf);
+               yyerror(form(PL_no_myglob,PL_tokenbuf));
 
            yylval.opval = newOP(OP_PADANY, 0);
            yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
@@ -1928,7 +1928,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets)
-               yyerror("Missing right bracket");
+               yyerror("Missing right curly or square bracket");
            TOKEN(0);
        }
        if (s++ < PL_bufend)
@@ -2372,7 +2372,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
     case ']':
        s++;
        if (PL_lex_brackets <= 0)
-           yyerror("Unmatched right bracket");
+           yyerror("Unmatched right square bracket");
        else
            --PL_lex_brackets;
        if (PL_lex_state == LEX_INTERPNORMAL) {
@@ -2529,7 +2529,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
       rightbracket:
        s++;
        if (PL_lex_brackets <= 0)
-           yyerror("Unmatched right bracket");
+           yyerror("Unmatched right curly bracket");
        else
            PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
        if (PL_lex_brackets < PL_lex_formbrack)
@@ -3129,7 +3129,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
                /* if we saw a global override before, get the right name */
 
                if (gvp) {
-                   sv = newSVpv("CORE::GLOBAL::",14);
+                   sv = newSVpvn("CORE::GLOBAL::",14);
                    sv_catpv(sv,PL_tokenbuf);
                }
                else
@@ -5011,7 +5011,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv)
-       pv = sv_2mortal(newSVpv(s, len));
+       pv = sv_2mortal(newSVpvn(s, len));
     if (type)
        typesv = sv_2mortal(newSVpv(type, 0));
     else
@@ -5352,8 +5352,11 @@ scan_subst(char *start)
 
     if (es) {
        SV *repl;
+       PL_sublex_info.super_bufptr = s;
+       PL_sublex_info.super_bufend = PL_bufend;
+       PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
-       repl = newSVpv("",0);
+       repl = newSVpvn("",0);
        while (es-- > 0)
            sv_catpv(repl, es ? "eval " : "do ");
        sv_catpvn(repl, "{ ", 2);
@@ -5521,9 +5524,9 @@ scan_heredoc(register char *s)
 #endif
     d = "\n";
     if (outer || !(d=ninstr(s,PL_bufend,d,d+1)))
-       herewas = newSVpv(s,PL_bufend-s);
+       herewas = newSVpvn(s,PL_bufend-s);
     else
-       s--, herewas = newSVpv(s,d-s);
+       s--, herewas = newSVpvn(s,d-s);
     s += SvCUR(herewas);
 
     tmpstr = NEWSV(87,79);
@@ -5541,7 +5544,33 @@ scan_heredoc(register char *s)
     PL_multi_start = PL_curcop->cop_line;
     PL_multi_open = PL_multi_close = '<';
     term = *PL_tokenbuf;
-    if (!outer) {
+    if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
+       char *bufptr = PL_sublex_info.super_bufptr;
+       char *bufend = PL_sublex_info.super_bufend;
+       char *olds = s - SvCUR(herewas);
+       s = strchr(bufptr, '\n');
+       if (!s)
+           s = bufend;
+       d = s;
+       while (s < bufend &&
+         (*s != term || memNE(s,PL_tokenbuf,len)) ) {
+           if (*s++ == '\n')
+               PL_curcop->cop_line++;
+       }
+       if (s >= bufend) {
+           PL_curcop->cop_line = PL_multi_start;
+           missingterm(PL_tokenbuf);
+       }
+       sv_setpvn(herewas,bufptr,d-bufptr+1);
+       sv_setpvn(tmpstr,d+1,s-d);
+       s += len - 1;
+       sv_catpvn(herewas,s,bufend-s);
+       (void)strcpy(bufptr,SvPVX(herewas));
+
+       s = olds;
+       goto retval;
+    }
+    else if (!outer) {
        d = s;
        while (s < PL_bufend &&
          (*s != term || memNE(s,PL_tokenbuf,len)) ) {
@@ -5605,8 +5634,9 @@ scan_heredoc(register char *s)
            sv_catsv(tmpstr,PL_linestr);
        }
     }
-    PL_multi_end = PL_curcop->cop_line;
     s++;
+retval:
+    PL_multi_end = PL_curcop->cop_line;
     if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
        SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
        Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
@@ -6028,17 +6058,17 @@ scan_num(char *start)
                /* 8 and 9 are not octal */
                case '8': case '9':
                    if (shift == 3)
-                       yyerror("Illegal octal digit");
+                       yyerror(form("Illegal octal digit '%c'", *s));
                    else
                        if (shift == 1)
-                           yyerror("Illegal binary digit");
+                           yyerror(form("Illegal binary digit '%c'", *s));
                    /* FALL THROUGH */
 
                /* octal digits */
                case '2': case '3': case '4':
                case '5': case '6': case '7':
                    if (shift == 1)
-                       yyerror("Illegal binary digit");
+                       yyerror(form("Illegal binary digit '%c'", *s));
                    /* FALL THROUGH */
 
                case '0': case '1':
@@ -6203,7 +6233,7 @@ scan_formline(register char *s)
     dTHR;
     register char *eol;
     register char *t;
-    SV *stuff = newSVpv("",0);
+    SV *stuff = newSVpvn("",0);
     bool needargs = FALSE;
 
     while (!needargs) {
@@ -6316,7 +6346,7 @@ start_subparse(I32 is_format, U32 flags)
     PL_padix = 0;
     PL_subline = PL_curcop->cop_line;
 #ifdef USE_THREADS
-    av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
 #endif /* USE_THREADS */
@@ -6385,7 +6415,7 @@ yyerror(char *s)
            where = "within string";
     }
     else {
-       SV *where_sv = sv_2mortal(newSVpv("next char ", 0));
+       SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
        if (yychar < 32)
            sv_catpvf(where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar))