provide File::Copy::syscopy() via Win32::CopyFile() on win32
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 1a17904..709db63 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;
     }
 
@@ -928,10 +928,10 @@ scan_const(char *start)
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
     I32 len;                                   /* ? */
-    I32 utf = PL_lex_inwhat == OP_TRANS
+    I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
        ? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
        : UTF;
-    I32 thisutf = PL_lex_inwhat == OP_TRANS
+    I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
        ? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
        : UTF;
 
@@ -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);
@@ -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)
@@ -2723,6 +2723,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
        }
 
        d = s;
+       tmp = (I32)*s;
        if (PL_lex_state == LEX_NORMAL)
            s = skipspace(s);
 
@@ -2764,7 +2765,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
        }
 
        PL_expect = XOPERATOR;
-       if (PL_lex_state == LEX_NORMAL && isSPACE(*d)) {
+       if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
            bool islop = (PL_last_lop == PL_oldoldbufptr);
            if (!islop || PL_last_lop_op == OP_GREPSTART)
                PL_expect = XOPERATOR;
@@ -3129,7 +3130,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 +5012,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
@@ -5356,7 +5357,7 @@ scan_subst(char *start)
        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);
@@ -5524,9 +5525,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);
@@ -5669,19 +5670,23 @@ scan_inputsymbol(char *start)
     register char *s = start;          /* current position in buffer */
     register char *d;
     register char *e;
+    char *end;
     I32 len;
 
     d = PL_tokenbuf;                   /* start of temp holding space */
     e = PL_tokenbuf + sizeof PL_tokenbuf;      /* end of temp holding space */
-    s = delimcpy(d, e, s + 1, PL_bufend, '>', &len);   /* extract until > */
+    end = strchr(s, '\n');
+    if (!end)
+       end = PL_bufend;
+    s = delimcpy(d, e, s + 1, end, '>', &len); /* extract until > */
 
     /* die if we didn't have space for the contents of the <>,
-       or if it didn't end
+       or if it didn't end, or if we see a newline
     */
 
     if (len >= sizeof PL_tokenbuf)
        croak("Excessively long <> operator");
-    if (s >= PL_bufend)
+    if (s >= end)
        croak("Unterminated <> operator");
 
     s++;
@@ -6058,17 +6063,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':
@@ -6233,7 +6238,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) {
@@ -6346,7 +6351,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 */
@@ -6415,7 +6420,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))