From f5ada144f34d75c136b6780e10ca13d18d44c557 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Sun, 29 May 2011 17:13:07 +0100
Subject: [PATCH] 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.
---
 pp_ctl.c     | 14 ++++++++++----
 t/op/write.t | 25 ++++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index fbb0e34..524fa43 100644
--- 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
--- 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');
-- 
2.7.4