pp_formline: keep linemark consistent

linemark is a pointer to the current start of the line. This allows
things like ~ to delete back to the start of the line.

Convert it into an offset, so that it isn't invalidated if PL_formtarget
is reallocated. Also recalculate it if PL_formtarget is upgraded to utf8.

diff --git a/pp_ctl.c b/pp_ctl.c
index fbb0e34..524fa43 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -535,7 +535,7 @@ PP(pp_formline)
     I32 lines = 0;         /* number of lines that have been output */
     bool chopspace = (strchr(PL_chopset, ' ') != NULL); /* does $: have space */
     const char *chophere = NULL; /* where to chop current item */
-    char *linemark = NULL;  /* pos of start of line in output */
+    STRLEN linemark = 0;    /* pos of start of line in output */
     NV value;
     bool gotsome = FALSE;   /* seen at least one non-blank item on this line */
     STRLEN len;
@@ -598,7 +598,7 @@ PP(pp_formline)
        } );
        switch (*fpc++) {
        case FF_LINEMARK:
-           linemark = t;
+           linemark = t - SvPVX(PL_formtarget);
            lines++;
            gotsome = FALSE;
            break;
@@ -850,11 +850,17 @@ PP(pp_formline)
                    source = tmp = bytes_to_utf8(source, &to_copy);
                } else {
                    if (item_is_utf8 && !targ_is_utf8) {
+                       U8 *s;
                        /* Upgrade targ to UTF8, and then we reduce it to
                           a problem we have a simple solution for.
                           Don't need get magic.  */
                        sv_utf8_upgrade_nomg(PL_formtarget);
                        targ_is_utf8 = TRUE;
+                       /* re-calculate linemark */
+                       s = (U8*)SvPVX(PL_formtarget);
+                       while (linemark--)
+                           s += UTF8SKIP(s);
+                       linemark = s - (U8*)SvPVX(PL_formtarget);
                    }
                    /* Easy. They agree.  */
                    assert (item_is_utf8 == targ_is_utf8);
@@ -941,7 +947,7 @@ PP(pp_formline)
 
        case FF_NEWLINE:
            f++;
-           while (t-- > linemark && *t == ' ') ;
+           while (t-- > (SvPVX(PL_formtarget) + linemark) && *t == ' ') ;
            t++;
            *t++ = '\n';
            break;
@@ -955,7 +961,7 @@ PP(pp_formline)
                }
            }
            else {
-               t = linemark;
+               t = SvPVX(PL_formtarget) + linemark;
                lines--;
            }
            break;

diff --git a/t/op/write.t b/t/op/write.t
index 646143d..27effde 100644 (file)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -61,7 +61,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 20;
 
 # number of tests in section 3
-my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 2 + 1 + 1;
+my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 2 + 2 + 1 + 1;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -683,6 +683,29 @@ ok  defined *{$::{CmT}}{FORMAT}, "glob assign";
     }
 }
 
+# check that '~  (delete current line if empty) works when
+# the target gets upgraded to uft8 (and re-allocated) midstream.
+
+{
+    my $format = "\x{100}@~\n"; # format is utf8
+    # this target is not utf8, but will expand (and get reallocated)
+    # when upgraded to utf8.
+    my $orig = "\x80\x81\x82";
+    local $^A = $orig;
+    my $empty = "";
+    formline $format, $empty;
+    is $^A , $orig, "~ and realloc";
+
+    # check similarly that trailing blank removal works ok
+
+    $format = "@<\n\x{100}"; # format is utf8
+    chop $format;
+    $orig = "   ";
+    $^A = $orig;
+    formline $format, "  ";
+    is $^A, "$orig\n", "end-of-line blanks and realloc";
+}
+
 
 SKIP: {
     skip_if_miniperl('miniperl does not support scalario');