perlre: Add note that nested (?>...) are not no-ops

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 0b3e2aa..9f37f53 100644 (file)
--- 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;
 
@@ -11078,9 +11089,11 @@ 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) {
@@ -11091,7 +11104,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                                     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
@@ -11141,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
@@ -11410,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)) {
@@ -11427,7 +11439,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
             } else {
                 nv = Atof(PL_tokenbuf);
             }
-            RESTORE_LC_NUMERIC_UNDERLYING();
             sv = newSVnv(nv);
        }