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

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 1519d41..9f37f53 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -316,6 +316,7 @@ static struct debug_tokens {
     { BITOROP,         TOKENTYPE_OPNUM,        "BITOROP" },
     { COLONATTR,       TOKENTYPE_NONE,         "COLONATTR" },
     { CONTINUE,                TOKENTYPE_NONE,         "CONTINUE" },
+    { DEFAULT,         TOKENTYPE_NONE,         "DEFAULT" },
     { DO,              TOKENTYPE_NONE,         "DO" },
     { DOLSHARP,                TOKENTYPE_NONE,         "DOLSHARP" },
     { DORDOR,          TOKENTYPE_NONE,         "DORDOR" },
@@ -374,7 +375,7 @@ static struct debug_tokens {
     { UNLESS,          TOKENTYPE_IVAL,         "UNLESS" },
     { UNTIL,           TOKENTYPE_IVAL,         "UNTIL" },
     { USE,             TOKENTYPE_IVAL,         "USE" },
-    { WHERESO,         TOKENTYPE_IVAL,         "WHERESO" },
+    { WHEN,            TOKENTYPE_IVAL,         "WHEN" },
     { WHILE,           TOKENTYPE_IVAL,         "WHILE" },
     { BAREWORD,                TOKENTYPE_OPVAL,        "BAREWORD" },
     { YADAYADA,                TOKENTYPE_IVAL,         "YADAYADA" },
@@ -2389,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;
@@ -2568,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);
@@ -4156,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;
 
@@ -7777,6 +7795,9 @@ Perl_yylex(pTHX)
        case KEY_bless:
            LOP(OP_BLESS,XTERM);
 
+       case KEY_break:
+           FUN0(OP_BREAK);
+
        case KEY_chop:
            UNI(OP_CHOP);
 
@@ -7838,6 +7859,9 @@ Perl_yylex(pTHX)
        case KEY_chroot:
            UNI(OP_CHROOT);
 
+       case KEY_default:
+           PREBLOCK(DEFAULT);
+
        case KEY_do:
            s = skipspace(s);
            if (*s == '{')
@@ -8839,16 +8863,14 @@ Perl_yylex(pTHX)
        case KEY_vec:
            LOP(OP_VEC,XTERM);
 
-       case KEY_whereis:
-       case KEY_whereso:
+       case KEY_when:
            if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
                return REPORT(0);
-           pl_yylval.ival = tmp == KEY_whereis;
-           /* diag_listed_as: whereso is experimental */
+           pl_yylval.ival = CopLINE(PL_curcop);
             Perl_ck_warner_d(aTHX_
                 packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
-                "%" UTF8f " is experimental", UTF8fARG(UTF, len, PL_tokenbuf));
-           OPERATOR(WHERESO);
+                "when is experimental");
+           OPERATOR(WHEN);
 
        case KEY_while:
            if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
@@ -9575,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
@@ -10558,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;
 
@@ -11400,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)) {
@@ -11417,7 +11439,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
             } else {
                 nv = Atof(PL_tokenbuf);
             }
-            RESTORE_LC_NUMERIC_UNDERLYING();
             sv = newSVnv(nv);
        }