This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_formline: don't do get mg on PL_formtarget
[perl5.git] / pp_ctl.c
index 79b7d32..2f0ddcd 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -545,6 +545,8 @@ PP(pp_formline)
     SV * nsv = NULL;
     const char *fmt;
     MAGIC *mg = NULL;
+    U8 *source;                    /* source of bytes to append */
+    STRLEN to_copy;        /* how may bytes to append */
 
     mg = doparseform(tmpForm);
 
@@ -628,7 +630,7 @@ PP(pp_formline)
            if (!targ_is_utf8 && DO_UTF8(formsv)) {
                SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
                *t = '\0';
-               sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC, fudge + 1);
+               sv_utf8_upgrade_flags_grow(PL_formtarget, 0, fudge + 1);
                t = SvEND(PL_formtarget);
                targ_is_utf8 = TRUE;
            }
@@ -814,7 +816,7 @@ PP(pp_formline)
                    if (!targ_is_utf8) {
                        SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
                        *t = '\0';
-                       sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC,
+                       sv_utf8_upgrade_flags_grow(PL_formtarget, 0,
                                                                    fudge + 1);
                        t = SvEND(PL_formtarget);
                        targ_is_utf8 = TRUE;
@@ -889,72 +891,75 @@ PP(pp_formline)
            {
                const bool oneline = fpc[-1] == FF_LINESNGL;
                const char *s = item = SvPV_const(sv, len);
+               const char *const send = s + len;
+
                item_is_utf8 = DO_UTF8(sv);
                itemsize = len;
-               if (itemsize) {
-                   STRLEN to_copy = itemsize;
-                   const char *const send = s + len;
-                   const U8 *source = (const U8 *) s;
-                   U8 *tmp = NULL;
-
-                   gotsome = TRUE;
-                   chophere = s + itemsize;
-                   while (s < send) {
-                       if (*s++ == '\n') {
-                           if (oneline) {
-                               to_copy = s - SvPVX_const(sv) - 1;
-                               chophere = s;
-                               break;
-                           } else {
-                               if (s == send) {
-                                   itemsize--;
-                                   to_copy--;
-                               } else
-                                   lines++;
-                           }
+               if (!itemsize)
+                   break;
+               gotsome = TRUE;
+               chophere = s + itemsize;
+               source = (U8 *) s;
+               to_copy = len;
+               while (s < send) {
+                   if (*s++ == '\n') {
+                       if (oneline) {
+                           to_copy = s - SvPVX_const(sv) - 1;
+                           chophere = s;
+                           break;
+                       } else {
+                           if (s == send) {
+                               itemsize--;
+                               to_copy--;
+                           } else
+                               lines++;
                        }
                    }
-                   if (targ_is_utf8 && !item_is_utf8) {
-                       source = tmp = bytes_to_utf8(source, &to_copy);
+               }
+           }
+
+           {
+               U8 *tmp = NULL;
+               if (targ_is_utf8 && !item_is_utf8) {
+                   source = tmp = bytes_to_utf8(source, &to_copy);
+                   SvCUR_set(PL_formtarget,
+                             t - SvPVX_const(PL_formtarget));
+               } else {
+                   if (item_is_utf8 && !targ_is_utf8) {
+                       /* Upgrade targ to UTF8, and then we reduce it to
+                          a problem we have a simple solution for.  */
                        SvCUR_set(PL_formtarget,
                                  t - SvPVX_const(PL_formtarget));
+                       targ_is_utf8 = TRUE;
+                       /* Don't need get magic.  */
+                       sv_utf8_upgrade_nomg(PL_formtarget);
                    } else {
-                       if (item_is_utf8 && !targ_is_utf8) {
-                           /* Upgrade targ to UTF8, and then we reduce it to
-                              a problem we have a simple solution for.  */
-                           SvCUR_set(PL_formtarget,
-                                     t - SvPVX_const(PL_formtarget));
-                           targ_is_utf8 = TRUE;
-                           /* Don't need get magic.  */
-                           sv_utf8_upgrade_nomg(PL_formtarget);
-                       } else {
-                           SvCUR_set(PL_formtarget,
-                                     t - SvPVX_const(PL_formtarget));
-                       }
-
-                       /* Easy. They agree.  */
-                       assert (item_is_utf8 == targ_is_utf8);
+                       SvCUR_set(PL_formtarget,
+                                 t - SvPVX_const(PL_formtarget));
                    }
-                   SvGROW(PL_formtarget,
-                          SvCUR(PL_formtarget) + to_copy + fudge + 1);
-                   t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
-
-                   Copy(source, t, to_copy, char);
-                   t += to_copy;
-                   SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy);
-                   if (item_is_utf8) {
-                       if (SvGMAGICAL(sv)) {
-                           /* Mustn't call sv_pos_b2u() as it does a second
-                              mg_get(). Is this a bug? Do we need a _flags()
-                              variant? */
-                           itemsize = utf8_length(source, source + itemsize);
-                       } else {
-                           sv_pos_b2u(sv, &itemsize);
-                       }
-                       assert(!tmp);
-                   } else if (tmp) {
-                       Safefree(tmp);
+
+                   /* Easy. They agree.  */
+                   assert (item_is_utf8 == targ_is_utf8);
+               }
+               SvGROW(PL_formtarget,
+                      SvCUR(PL_formtarget) + to_copy + fudge + 1);
+               t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
+
+               Copy(source, t, to_copy, char);
+               t += to_copy;
+               SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy);
+               if (item_is_utf8) {
+                   if (SvGMAGICAL(sv)) {
+                       /* Mustn't call sv_pos_b2u() as it does a second
+                          mg_get(). Is this a bug? Do we need a _flags()
+                          variant? */
+                       itemsize = utf8_length(source, source + itemsize);
+                   } else {
+                       sv_pos_b2u(sv, &itemsize);
                    }
+                   assert(!tmp);
+               } else if (tmp) {
+                   Safefree(tmp);
                }
                break;
            }
@@ -1018,14 +1023,8 @@ PP(pp_formline)
            arg = *fpc++;
            if (gotsome) {
                if (arg) {              /* repeat until fields exhausted? */
-                   *t = '\0';
-                   SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
-                   lines += FmLINES(PL_formtarget);
-                   if (targ_is_utf8)
-                       SvUTF8_on(PL_formtarget);
-                   FmLINES(PL_formtarget) = lines;
-                   SP = ORIGMARK;
-                   RETURNOP(cLISTOP->op_first);
+                   fpc--;
+                   goto end;
                }
            }
            else {
@@ -1062,13 +1061,17 @@ PP(pp_formline)
                break;
            }
        case FF_END:
+       end:
            *t = '\0';
            SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
            if (targ_is_utf8)
                SvUTF8_on(PL_formtarget);
            FmLINES(PL_formtarget) += lines;
            SP = ORIGMARK;
-           RETPUSHYES;
+           if (fpc[-1] == FF_BLANK)
+               RETURNOP(cLISTOP->op_first);
+           else
+               RETPUSHYES;
        }
     }
 }