X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=709db636d1986ed5edcd125834c6e3213780330b;hb=7509b6572737d9774c4d9688c4edf46238aa95f2;hp=1a17904f2cbef6c40142ab9be80662e6435cc3b0;hpb=0244c3a403af2426ac6678d042024bb183ebbfa9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 1a17904..709db63 100644 --- 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))