X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/76b35304cf4800e9e0f7b370b9f1f40bc6cfb7e0..30457add2d1f514977190c5b66b67eae3b64bcc6:/toke.c diff --git a/toke.c b/toke.c index 70e7de0..9f37f53 100644 --- a/toke.c +++ b/toke.c @@ -456,9 +456,9 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s) PERL_ARGS_ASSERT_PRINTBUF; - GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */ + GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* fmt checked by caller */ PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60)); - GCC_DIAG_RESTORE; + GCC_DIAG_RESTORE_STMT; SvREFCNT_dec(tmp); } @@ -2390,6 +2390,8 @@ S_sublex_start(pTHX) PL_parser->lex_super_state = PL_lex_state; PL_parser->lex_sub_inwhat = (U16)op_type; PL_parser->lex_sub_op = PL_lex_op; + PL_parser->sub_no_recover = FALSE; + PL_parser->sub_error_count = PL_error_count; PL_lex_state = LEX_INTERPPUSH; PL_expect = XTERM; @@ -2569,6 +2571,20 @@ S_sublex_done(pTHX) else { const line_t l = CopLINE(PL_curcop); LEAVE; + if (PL_parser->sub_error_count != PL_error_count) { + const char * const name = OutCopFILE(PL_curcop); + if (PL_parser->sub_no_recover) { + const char * msg = ""; + if (PL_in_eval) { + SV *errsv = ERRSV; + if (SvCUR(ERRSV)) { + msg = Perl_form(aTHX_ "%" SVf, SVfARG(errsv)); + } + } + abort_execution(msg, name); + NOT_REACHED; + } + } if (PL_multi_close == '<') PL_parser->herelines += l - PL_multi_end; PL_bufend = SvPVX(PL_linestr); @@ -4157,6 +4173,7 @@ S_intuit_more(pTHX_ char *s, char *e) return TRUE; if (*s != '{' && *s != '[') return FALSE; + PL_parser->sub_no_recover = TRUE; if (!PL_lex_inpat) return TRUE; @@ -7611,10 +7628,10 @@ Perl_yylex(pTHX) if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0)) { /* PL_warn_reserved is constant */ - GCC_DIAG_IGNORE(-Wformat-nonliteral); + GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved, PL_tokenbuf); - GCC_DIAG_RESTORE; + GCC_DIAG_RESTORE_STMT; } } } @@ -7669,14 +7686,6 @@ Perl_yylex(pTHX) if (!GvIO(gv)) GvIOp(gv) = newIO(); IoIFP(GvIOp(gv)) = PL_rsfp; -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - { - const int fd = PerlIO_fileno(PL_rsfp); - if (fd >= 3) { - fcntl(fd,F_SETFD, FD_CLOEXEC); - } - } -#endif /* Mark this internal pseudo-handle as clean */ IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT; if ((PerlIO*)PL_rsfp == PerlIO_stdin()) @@ -8943,6 +8952,7 @@ S_pending_ident(pTHX) DEBUG_T({ PerlIO_printf(Perl_debug_log, "### Pending identifier '%s'\n", PL_tokenbuf); }); + assert(tokenbuf_len >= 2); /* if we're in a my(), we can't allow dynamics here. $foo'bar has already been turned into $foo::bar, so @@ -8966,13 +8976,13 @@ S_pending_ident(pTHX) if (has_colon) { /* "my" variable %s can't be in a package */ /* PL_no_myglob is constant */ - GCC_DIAG_IGNORE(-Wformat-nonliteral); + GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); yyerror_pv(Perl_form(aTHX_ PL_no_myglob, PL_in_my == KEY_my ? "my" : "state", *PL_tokenbuf == '&' ? "subroutin" : "variabl", PL_tokenbuf), UTF ? SVf_UTF8 : 0); - GCC_DIAG_RESTORE; + GCC_DIAG_RESTORE_STMT; } if (PL_in_my == KEY_sigvar) { @@ -9587,6 +9597,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) CopLINE_set(PL_curcop, orig_copline); PL_parser->herelines = herelines; *dest = '\0'; + PL_parser->sub_no_recover = TRUE; } } else if ( PL_lex_state == LEX_INTERPNORMAL @@ -10570,7 +10581,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re I32 brackets = 1; /* bracket nesting level */ bool has_utf8 = FALSE; /* is there any utf8 content? */ IV termcode; /* terminating char. code */ - U8 termstr[UTF8_MAXBYTES]; /* terminating string */ + U8 termstr[UTF8_MAXBYTES+1]; /* terminating string */ STRLEN termlen; /* length of terminating string */ line_t herelines; @@ -10997,6 +11008,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) digit: just_zero = FALSE; if (!overflowed) { + assert(shift >= 0); x = u << shift; /* make room for the digit */ total_bits += shift; @@ -11077,19 +11089,22 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) NV nv_mult = 1.0; #endif bool accumulate = TRUE; - for (h++; (isXDIGIT(*h) || *h == '_'); h++) { + U8 b; + int lim = 1 << shift; + for (h++; ((isXDIGIT(*h) && (b = XDIGIT_VALUE(*h)) < lim) || + *h == '_'); h++) { if (isXDIGIT(*h)) { - U8 b = XDIGIT_VALUE(*h); significant_bits += shift; #ifdef HEXFP_UQUAD if (accumulate) { if (significant_bits < NV_MANT_DIG) { /* We are in the long "run" of xdigits, * accumulate the full four bits. */ + assert(shift >= 0); hexfp_uquad <<= shift; hexfp_uquad |= b; hexfp_frac_bits += shift; - } else { + } else if (significant_bits - shift < NV_MANT_DIG) { /* We are at a hexdigit either at, * or straddling, the edge of mantissa. * We will try grabbing as many as @@ -11098,7 +11113,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) significant_bits - NV_MANT_DIG; if (tail <= 0) tail += shift; + assert(tail >= 0); hexfp_uquad <<= tail; + assert((shift - tail) >= 0); hexfp_uquad |= b >> (shift - tail); hexfp_frac_bits += tail; @@ -11137,7 +11154,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } #else /* HEXFP_NV */ if (accumulate) { - nv_mult /= 16.0; + nv_mult /= nvshift[shift]; if (nv_mult > 0.0) hexfp_nv += b * nv_mult; else @@ -11406,7 +11423,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) floatit = TRUE; } if (floatit) { - STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD(); /* terminate the string */ *d = '\0'; if (UNLIKELY(hexfp)) { @@ -11423,7 +11439,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } else { nv = Atof(PL_tokenbuf); } - RESTORE_LC_NUMERIC_UNDERLYING(); sv = newSVnv(nv); }