From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 11 Jul 2008 20:04:57 +0000 (+0000)
Subject: Regression tests for, and fix quite a lot of bugs in, cases FF_LINESNGL
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3f2f1a3479714dd7c55621da87bce4872a4ab17;p=p5sagit%2Fp5-mst-13.2.git

Regression tests for, and fix quite a lot of bugs in, cases FF_LINESNGL
and FF_LINEGLOB in pp_formline. (While investigating RT #55668)
Sometimes I wonder if this is actually fun.

p4raw-id: //depot/perl@34129
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 3c6ab23..6a0c804 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -503,6 +503,7 @@ PP(pp_formline)
 		*t = '\0';
 		sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
 		t = SvEND(PL_formtarget);
+		f += arg;
 		break;
 	    }
 	    if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
@@ -767,9 +768,8 @@ PP(pp_formline)
 	    {
 		const bool oneline = fpc[-1] == FF_LINESNGL;
 		const char *s = item = SvPV_const(sv, len);
+		item_is_utf8 = DO_UTF8(sv);
 		itemsize = len;
-		if ((item_is_utf8 = DO_UTF8(sv)))
-		    itemsize = sv_len_utf8(sv);
 		if (itemsize) {
 		    bool chopped = FALSE;
 		    const char *const send = s + len;
@@ -791,8 +791,6 @@ PP(pp_formline)
 			}
 		    }
 		    SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
-		    if (targ_is_utf8)
-			SvUTF8_on(PL_formtarget);
 		    if (oneline) {
 			SvCUR_set(sv, chophere - item);
 			sv_catsv(PL_formtarget, sv);
@@ -803,8 +801,10 @@ PP(pp_formline)
 			SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
 		    SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
 		    t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
-		    if (item_is_utf8)
+		    if (item_is_utf8) {
 			targ_is_utf8 = TRUE;
+			sv_pos_b2u(sv, &itemsize);
+		    }
 		}
 		break;
 	    }
diff --git a/t/op/write.t b/t/op/write.t
index 853b129..89b5beb 100755
--- 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;
+my $bug_tests = 4 + 3 * 3 * 3;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -511,6 +511,27 @@ for my $tref ( @NumTests ){
     like $@, qr/Undefined format/, 'no such format';
 }
 
+{
+  my ($pound_utf8, $pm_utf8) = map { my $a = "$_\x{100}"; chop $a; $a} 
+    my ($pound, $pm) = ("\xA3", "\xB1");
+
+  foreach my $first ('N', $pound, $pound_utf8) {
+    foreach my $base ('N', $pm, $pm_utf8) {
+      foreach my $second ($base, "$base\n", "$base\nMoo!") {
+	my $name = "$first, $second";
+	$name =~ s/\n/\\n/;
+
+	my ($copy1, $copy2) = ($first, $second);
+	$first =~ /(.+)/ or die $first;
+	my $expect = "1${1}2";
+	$second =~ /(.+)/ or die $second;
+	$expect .= " 3${1}4";
+
+	is swrite('1^*2 3^*4', $copy1, $copy2), $expect, $name;
+      }
+    }
+  }
+}
 
 format EMPTY =
 .