Perl_try_amagic_bin(): eliminate dATARGET

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 66a02e2..5a3fe78 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1829,14 +1829,14 @@ S_incline(pTHX_ const char *s, const char *end)
                    }
                    else if (GvAV(cfgv)) {
                        AV * const av = GvAV(cfgv);
-                       const I32 start = CopLINE(PL_curcop)+1;
-                       I32 items = AvFILLp(av) - start;
+                       const line_t start = CopLINE(PL_curcop)+1;
+                       SSize_t items = AvFILLp(av) - start;
                        if (items > 0) {
                            AV * const av2 = GvAVn(gv2);
                            SV **svp = AvARRAY(av) + start;
-                           I32 l = (I32)line_num+1;
-                           while (items--)
-                               av_store(av2, l++, SvREFCNT_inc(*svp++));
+                           Size_t l = line_num+1;
+                           while (items-- && l < SSize_t_MAX && l == (line_t)l)
+                               av_store(av2, (SSize_t)l++, SvREFCNT_inc(*svp++));
                        }
                    }
                }
@@ -2575,16 +2575,8 @@ S_sublex_done(pTHX)
        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);
+                yyquit();
                 NOT_REACHED;
             }
         }
@@ -5099,6 +5091,14 @@ Perl_yylex(pTHX)
 
        return yylex();
     case LEX_FORMLINE:
+        if (PL_parser->sub_error_count != PL_error_count) {
+            /* There was an error parsing a formline, which tends to
+               mess up the parser.
+               Unlike interpolated sub-parsing, we can't treat any of
+               these as recoverable, so no need to check sub_no_recover.
+            */
+            yyquit();
+        }
        assert(PL_lex_formbrack);
        s = scan_formline(PL_bufptr);
        if (!PL_lex_formbrack)
@@ -6518,6 +6518,7 @@ Perl_yylex(pTHX)
                SAVEI32(PL_lex_formbrack);
                PL_parser->form_lex_state = PL_lex_state;
                PL_lex_formbrack = PL_lex_brackets + 1;
+                PL_parser->sub_error_count = PL_error_count;
                goto leftbracket;
            }
        }
@@ -7248,10 +7249,7 @@ Perl_yylex(pTHX)
            else {                      /* no override */
                tmp = -tmp;
                if (tmp == KEY_dump) {
-                   Perl_ck_warner_d(aTHX_ packWARN2(WARN_MISC,WARN_DEPRECATED),
-                                    "dump() better written as CORE::dump(). "
-                                     "dump() will no longer be available "
-                                     "in Perl 5.30");
+                   Perl_croak(aTHX_ "dump() must be written as CORE::dump() as of Perl 5.30");
                }
                gv = NULL;
                gvp = 0;
@@ -8741,9 +8739,9 @@ Perl_yylex(pTHX)
                /* Look for a prototype */
                if (*s == '(' && !is_sigsub) {
                    s = scan_str(s,FALSE,FALSE,FALSE,NULL);
-                   COPLINE_SET_FROM_MULTI_END;
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
+                   COPLINE_SET_FROM_MULTI_END;
                    (void)validate_proto(PL_subname, PL_lex_stuff,
                                         ckWARN(WARN_ILLEGALPROTO), 0);
                    have_proto = TRUE;
@@ -10331,7 +10329,7 @@ S_scan_heredoc(pTHX_ char *s)
        while (ss < se) {
            /* newline only? Copy and move on */
            if (*ss == '\n') {
-               sv_catpv(newstr,"\n");
+               sv_catpvs(newstr,"\n");
                ss++;
                linecount++;
 
@@ -10613,14 +10611,11 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
     const char * opening_delims = "([{<";
     const char * closing_delims = ")]}>";
 
+    /* The only non-UTF character that isn't a stand alone grapheme is
+     * white-space, hence can't be a delimiter. */
     const char * non_grapheme_msg = "Use of unassigned code point or"
                                     " non-standalone grapheme for a delimiter"
-                                    " will be a fatal error starting in Perl"
-                                    " 5.30";
-    /* The only non-UTF character that isn't a stand alone grapheme is
-     * white-space, hence can't be a delimiter.  So can skip for non-UTF-8 */
-    bool check_grapheme = UTF && ckWARN_d(WARN_DEPRECATED);
-
+                                    " is not allowed";
     PERL_ARGS_ASSERT_SCAN_STR;
 
     /* skip space before the delimiter */
@@ -10639,18 +10634,12 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
     }
     else {
        termcode = utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen);
-        if (UTF) {
-                 if (UNLIKELY(! _is_grapheme((U8 *) start,
-                                             (U8 *) s,
-                                             (U8 *) PL_bufend,
-                                             termcode)))
-            {
-                Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "%s", non_grapheme_msg);
-
-                /* Don't have to check the other end, as have already warned at
-                 * this one */
-                check_grapheme = FALSE;
-            }
+        if (UTF && UNLIKELY(! _is_grapheme((U8 *) start,
+                                           (U8 *) s,
+                                           (U8 *) PL_bufend,
+                                                  termcode)))
+        {
+            yyerror(non_grapheme_msg);
         }
 
        Copy(s, termstr, termlen, U8);
@@ -10716,14 +10705,13 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
                     if (   s + termlen <= PL_bufend
                         && memEQ(s + 1, (char*)termstr + 1, termlen - 1))
                     {
-                        if (   check_grapheme
+                        if (   UTF
                             && UNLIKELY(! _is_grapheme((U8 *) start,
-                                                              (U8 *) s,
-                                                              (U8 *) PL_bufend,
+                                                       (U8 *) s,
+                                                       (U8 *) PL_bufend,
                                                               termcode)))
                         {
-                            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                                        "%s", non_grapheme_msg);
+                            yyerror(non_grapheme_msg);
                         }
                        break;
                     }