X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=dcb44541e8d8dd68f6f5101800e6f2c02a659c47;hb=7f2c89897f1cc260c9f4949731056784f989703f;hp=5449c2feb252bd13424a6d86df229ad32bd08d44;hpb=e312add13ca0c0f4786c61b97428230d6171233c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 5449c2f..dcb4454 100644 --- a/toke.c +++ b/toke.c @@ -319,6 +319,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) } #endif +#if 0 STATIC I32 S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { @@ -329,7 +330,6 @@ S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv)); sv_usepvn(sv, (char*)tmps, tend - tmps); - } return count; } @@ -344,10 +344,10 @@ S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv)); sv_usepvn(sv, (char*)tmps, tend - tmps); - } return count; } +#endif /* * Perl_lex_start @@ -861,7 +861,7 @@ S_force_version(pTHX_ char *s) version = yylval.opval; ver = cSVOPx(version)->op_sv; if (SvPOK(ver) && !SvNIOK(ver)) { - SvUPGRADE(ver, SVt_PVNV); + (void)SvUPGRADE(ver, SVt_PVNV); SvNVX(ver) = str_to_version(ver); SvNOK_on(ver); /* hint that it is a version */ } @@ -1269,8 +1269,10 @@ S_scan_const(pTHX_ char *start) if (s[2] == '#') { while (s < send && *s != ')') *d++ = *s++; - } else if (s[2] == '{' /* This should match regcomp.c */ - || (s[2] == 'p' || s[2] == '?') && s[3] == '{') { + } + else if (s[2] == '{' /* This should match regcomp.c */ + || ((s[2] == 'p' || s[2] == '?') && s[3] == '{')) + { I32 count = 1; char *regparse = s + (s[2] == '{' ? 3 : 4); char c; @@ -1464,12 +1466,9 @@ S_scan_const(pTHX_ char *start) ++s; if (*s == '{') { char* e = strchr(s, '}'); - HV *hv; - SV **svp; - SV *res, *cv; + SV *res; STRLEN len; char *str; - char *why = Nullch; if (!e) { yyerror("Missing right brace on \\N{}"); @@ -2613,8 +2612,8 @@ Perl_yylex(pTHX) } d = moreswitches(d); } while (d); - if (PERLDB_LINE && !oldpdb || - ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) ) + if ((PERLDB_LINE && !oldpdb) || + ((PL_minus_n || PL_minus_p) && !(oldn || oldp))) /* if we have already added "LINE: while (<>) {", we must not do it again */ { @@ -3336,7 +3335,7 @@ Perl_yylex(pTHX) else if (isIDFIRST_lazy_if(s,UTF)) { char tmpbuf[sizeof PL_tokenbuf]; scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); - if (tmp = keyword(tmpbuf, len)) { + if ((tmp = keyword(tmpbuf, len))) { /* binary operators exclude handle interpretations */ switch (tmp) { case -KEY_x: @@ -3578,7 +3577,6 @@ Perl_yylex(pTHX) case 'z': case 'Z': keylookup: { - STRLEN n_a; gv = Nullgv; gvp = 0; @@ -3586,10 +3584,10 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); /* Some keywords can be followed by any delimiter, including ':' */ - tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) || - len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') || - (PL_tokenbuf[0] == 'q' && - strchr("qwxr", PL_tokenbuf[1])))); + tmp = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) || + (len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') || + (PL_tokenbuf[0] == 'q' && + strchr("qwxr", PL_tokenbuf[1]))))); /* x::* is just a word, unless x is "CORE" */ if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE")) @@ -3672,7 +3670,7 @@ Perl_yylex(pTHX) /* Get the rest if it looks like a package qualifier */ - if (*s == '\'' || *s == ':' && s[1] == ':') { + if (*s == '\'' || (*s == ':' && s[1] == ':')) { STRLEN morelen; s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, TRUE, &morelen); @@ -3960,7 +3958,8 @@ Perl_yylex(pTHX) s += 2; d = s; s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); - tmp = keyword(PL_tokenbuf, len); + if (!(tmp = keyword(PL_tokenbuf, len))) + Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf); if (tmp < 0) tmp = -tmp; goto reserved_word; @@ -3986,7 +3985,7 @@ Perl_yylex(pTHX) LOP(OP_BIND,XTERM); case KEY_binmode: - UNI(OP_BINMODE); + LOP(OP_BINMODE,XTERM); case KEY_bless: LOP(OP_BLESS,XTERM); @@ -5852,7 +5851,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des d++; if (UTF) { e = s; - while (e < send && isALNUM_lazy_if(e,UTF) || *e == ':') { + while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') { e += UTF8SKIP(e); while (e < send && *e & 0x80 && is_utf8_mark((U8*)e)) e += UTF8SKIP(e); @@ -6940,10 +6939,9 @@ Perl_scan_num(pTHX_ char *start) /* make an sv from the string */ sv = NEWSV(92,0); -#if ( defined(USE_64_BIT_INT) && \ - (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || \ - (!defined(USE_64_BIT_INT) && \ - (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL))) + /* unfortunately this monster needs to be on one line or + makedepend will be confused. */ +#if (defined(USE_64_BIT_INT) && (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || (!defined(USE_64_BIT_INT) && (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL))) /* No working strto[u]l[l]. Since atoi() doesn't do range checks, @@ -6981,22 +6979,14 @@ Perl_scan_num(pTHX_ char *start) */ if (!floatit) { - char *tp; IV iv; UV uv; errno = 0; -#ifdef USE_64_BIT_INT - if (*PL_tokenbuf == '-') - iv = strtoll(PL_tokenbuf,&tp,10); - else - uv = strtoull(PL_tokenbuf,&tp,10); -#else if (*PL_tokenbuf == '-') - iv = strtol(PL_tokenbuf,&tp,10); + iv = Strtol(PL_tokenbuf, (char**)NULL, 10); else - uv = strtoul(PL_tokenbuf,&tp,10); -#endif - if (*tp || errno) + uv = Strtoul(PL_tokenbuf, (char**)NULL, 10); + if (errno) floatit = TRUE; /* probably just too large */ else if (*PL_tokenbuf == '-') sv_setiv(sv, iv); @@ -7004,18 +6994,9 @@ Perl_scan_num(pTHX_ char *start) sv_setuv(sv, uv); } if (floatit) { - char *tp; - errno = 0; -#ifdef USE_LONG_DOUBLE - value = strtold(PL_tokenbuf,&tp); -#else - value = strtod(PL_tokenbuf,&tp); -#endif - if (*tp || errno) - Perl_die(aTHX_ "unparseable float"); - else - sv_setnv(sv, value); - } + value = Atof(PL_tokenbuf); + sv_setnv(sv, value); + } #endif if ( floatit ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) )