X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=727fc01825a790b53f990a671835a9483af261ba;hb=e526c9e6a142067a8efdc8a9f757505ff724adb1;hp=b9a12c41dadafd303dbae87c34b37a71d075a933;hpb=18b095192e336ba31465f4d3dab1ecc90871c3a9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index b9a12c4..727fc01 100644 --- a/toke.c +++ b/toke.c @@ -1,6 +1,6 @@ /* toke.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, 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. @@ -58,13 +58,6 @@ static void restore_rsfp(pTHXo_ void *f); #define LEX_FORMLINE 1 #define LEX_KNOWNEXT 0 -#ifdef I_FCNTL -#include -#endif -#ifdef I_SYS_FILE -#include -#endif - /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD # include /* Needed for execv() */ @@ -464,17 +457,22 @@ S_incline(pTHX_ char *s) dTHR; char *t; char *n; + char *e; char ch; - int sawline = 0; CopLINE_inc(PL_curcop); if (*s++ != '#') return; while (*s == ' ' || *s == '\t') s++; - if (strnEQ(s, "line ", 5)) { - s += 5; - sawline = 1; - } + if (strnEQ(s, "line", 4)) + s += 4; + else + return; + if (*s == ' ' || *s == '\t') + s++; + else + return; + while (*s == ' ' || *s == '\t') s++; if (!isDIGIT(*s)) return; n = s; @@ -482,13 +480,19 @@ S_incline(pTHX_ char *s) s++; while (*s == ' ' || *s == '\t') s++; - if (*s == '"' && (t = strchr(s+1, '"'))) + if (*s == '"' && (t = strchr(s+1, '"'))) { s++; + e = t + 1; + } else { - if (!sawline) - return; /* false alarm */ for (t = s; !isSPACE(*t); t++) ; + e = t; } + while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f') + e++; + if (*e != '\n' && *e != '\0') + return; /* false alarm */ + ch = *t; *t = '\0'; if (t - s > 0) @@ -817,18 +821,27 @@ STATIC char * S_force_version(pTHX_ char *s) { OP *version = Nullop; + bool is_vstr = FALSE; + char *d; s = skipspace(s); - if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { - char *d = s; - if (*d == 'v') - d++; + d = s; + if (*d == 'v') { + is_vstr = TRUE; + d++; + } + if (isDIGIT(*d)) { for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++); - if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') { + if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) { s = scan_num(s); /* real VERSION number -- GBARR */ version = yylval.opval; + if (is_vstr) { + SV *ver = cSVOPx(version)->op_sv; + SvUPGRADE(ver, SVt_PVIV); + SvIOKp_on(ver); /* hint that it is a version */ + } } } @@ -1335,8 +1348,8 @@ S_scan_const(pTHX_ char *start) default: { dTHR; - if (ckWARN(WARN_UNSAFE) && isALPHA(*s)) - Perl_warner(aTHX_ WARN_UNSAFE, + if (ckWARN(WARN_MISC) && isALPHA(*s)) + Perl_warner(aTHX_ WARN_MISC, "Unrecognized escape \\%c passed through", *s); /* default action is to copy the quoted character */ @@ -1356,18 +1369,24 @@ S_scan_const(pTHX_ char *start) ++s; if (*s == '{') { char* e = strchr(s, '}'); + UV uv; if (!e) { yyerror("Missing right brace on \\x{}"); e = s; } /* note: utf always shorter than hex */ - d = (char*)uv_to_utf8((U8*)d, - (UV)scan_hex(s + 1, e - s - 1, &len)); + uv = (UV)scan_hex(s + 1, e - s - 1, &len); + if (uv > 127) { + d = (char*)uv_to_utf8((U8*)d, uv); + has_utf = TRUE; + } + else + *d++ = (char)uv; s = e + 1; - has_utf = TRUE; } else { + /* XXX collapse this branch into the one above */ UV uv = (UV)scan_hex(s, 2, &len); if (utf && PL_lex_inwhat == OP_TRANS && utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) @@ -3448,7 +3467,7 @@ Perl_yylex(pTHX) OPERATOR(REFGEN); case 'v': - if (isDIGIT(s[1]) && PL_expect == XTERM) { + if (isDIGIT(s[1]) && PL_expect != XOPERATOR) { char *start = s; start++; start++; @@ -3458,6 +3477,18 @@ Perl_yylex(pTHX) s = scan_num(s); TERM(THING); } + /* avoid v123abc() or $h{v1}, allow C */ + else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF)) { + char c = *start; + GV *gv; + *start = '\0'; + gv = gv_fetchpv(s, FALSE, SVt_PVCV); + *start = c; + if (!gv) { + s = scan_num(s); + TERM(THING); + } + } } goto keylookup; case 'x': @@ -3617,8 +3648,8 @@ Perl_yylex(pTHX) if (len > 2 && PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':') { - if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV)) - Perl_warner(aTHX_ WARN_UNSAFE, + if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV)) + Perl_warner(aTHX_ WARN_BAREWORD, "Bareword \"%s\" refers to nonexistent package", PL_tokenbuf); len -= 2; @@ -3941,11 +3972,11 @@ Perl_yylex(pTHX) LOP(OP_CRYPT,XTERM); case KEY_chmod: - if (ckWARN(WARN_OCTAL)) { + if (ckWARN(WARN_CHMOD)) { for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; if (*d != '0' && isDIGIT(*d)) - Perl_warner(aTHX_ WARN_OCTAL, - "chmod: mode argument is missing initial 0"); + Perl_warner(aTHX_ WARN_CHMOD, + "chmod() mode argument is missing initial 0"); } LOP(OP_CHMOD,XTERM); @@ -4315,8 +4346,8 @@ Perl_yylex(pTHX) char *t; for (d = s; isALNUM_lazy_if(d,UTF); d++) ; t = skipspace(d); - if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS)) - Perl_warner(aTHX_ WARN_AMBIGUOUS, + if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)) + Perl_warner(aTHX_ WARN_PRECEDENCE, "Precedence problem: open %.*s should be open(%.*s)", d-s,s, d-s,s); } @@ -4388,15 +4419,15 @@ Perl_yylex(pTHX) for (; isSPACE(*d) && len; --len, ++d) ; if (len) { char *b = d; - if (!warned && ckWARN(WARN_SYNTAX)) { + if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { if (*d == ',') { - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ WARN_QW, "Possible attempt to separate words with commas"); ++warned; } else if (*d == '#') { - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ WARN_QW, "Possible attempt to put comments in qw() list"); ++warned; } @@ -4803,10 +4834,10 @@ Perl_yylex(pTHX) LOP(OP_UTIME,XTERM); case KEY_umask: - if (ckWARN(WARN_OCTAL)) { + if (ckWARN(WARN_UMASK)) { for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; if (*d != '0' && isDIGIT(*d)) - Perl_warner(aTHX_ WARN_OCTAL, + Perl_warner(aTHX_ WARN_UMASK, "umask: argument is missing initial 0"); } UNI(OP_UMASK); @@ -6885,47 +6916,39 @@ Perl_scan_num(pTHX_ char *start) pos++; while (isDIGIT(*pos)) pos++; - if (*pos == '.' && isDIGIT(pos[1])) { + if (!isALPHA(*pos)) { UV rev; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tmpend; - NV nshift = 1.0; + bool utf8 = FALSE; s++; /* get past 'v' */ sv = NEWSV(92,5); - SvUPGRADE(sv, SVt_PVNV); sv_setpvn(sv, "", 0); - do { + for (;;) { if (*s == '0' && isDIGIT(s[1])) yyerror("Octal number in vector unsupported"); rev = atoi(s); - s = ++pos; - while (isDIGIT(*pos)) - pos++; - tmpend = uv_to_utf8(tmpbuf, rev); - *tmpend = '\0'; + utf8 = utf8 || rev > 127; sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); - if (rev > 0) - SvNVX(sv) += (NV)rev/nshift; - nshift *= 1000; - } while (*pos == '.' && isDIGIT(pos[1])); - - if (*s == '0' && isDIGIT(s[1])) - yyerror("Octal number in vector unsupported"); - rev = atoi(s); - s = pos; - tmpend = uv_to_utf8(tmpbuf, rev); - *tmpend = '\0'; - sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); - if (rev > 0) - SvNVX(sv) += (NV)rev/nshift; + if (*pos == '.' && isDIGIT(pos[1])) + s = ++pos; + else { + s = pos; + break; + } + while (isDIGIT(*pos)) + pos++; + } SvPOK_on(sv); - SvNOK_on(sv); SvREADONLY_on(sv); - SvUTF8_on(sv); + if (utf8) { + SvUTF8_on(sv); + sv_utf8_downgrade(sv, TRUE); + } } } break; @@ -7125,7 +7148,12 @@ Perl_yyerror(pTHX_ char *s) } else if (yychar > 255) where = "next token ???"; +#ifdef USE_PURE_BISON +/* GNU Bison sets the value -2 */ + else if (yychar == -2) { +#else else if ((yychar & 127) == 127) { +#endif if (PL_lex_state == LEX_NORMAL || (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL)) where = "at end of line";