Change 34268 by [EMAIL PROTECTED] on 2008/09/05 10:06:01
Integrate:
[ 34125]
Simplify code in pp_formline, removing a goto and localising and
consting a variable.
[ 34129]
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.
[ 34135]
Format tests for @* too.
Affected files ...
... //depot/maint-5.10/perl/pp_ctl.c#19 integrate
... //depot/maint-5.10/perl/t/op/write.t#3 integrate
Differences ...
==== //depot/maint-5.10/perl/pp_ctl.c#19 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#18~34266~ 2008-09-04 08:33:04.000000000 -0700
+++ perl/pp_ctl.c 2008-09-05 03:06:01.000000000 -0700
@@ -429,7 +429,6 @@
SV * nsv = NULL;
OP * parseres = NULL;
const char *fmt;
- bool oneline;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
if (SvREADONLY(tmpForm)) {
@@ -495,6 +494,7 @@
*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)) {
@@ -755,16 +755,12 @@
case FF_LINESNGL:
chopspace = 0;
- oneline = TRUE;
- goto ff_line;
case FF_LINEGLOB:
- oneline = FALSE;
- ff_line:
{
+ 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;
@@ -786,8 +782,6 @@
}
}
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);
@@ -798,8 +792,10 @@
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;
}
==== //depot/maint-5.10/perl/t/op/write.t#3 (xtext) ====
Index: perl/t/op/write.t
--- perl/t/op/write.t#2~34255~ 2008-09-03 13:49:16.000000000 -0700
+++ perl/t/op/write.t 2008-09-05 03:06:01.000000000 -0700
@@ -61,7 +61,7 @@
my $bas_tests = 20;
# number of tests in section 3
-my $bug_tests = 4;
+my $bug_tests = 4 + 3 * 3 * 5 * 2;
# number of tests in section 4
my $hmb_tests = 35;
@@ -511,6 +511,31 @@
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!", "$base\nMoo!\n",
+ "$base\nMoo!\n",) {
+ foreach (['^*', qr/(.+)/], ['@*', qr/(.*?)$/s]) {
+ my ($format, $re) = @$_;
+ my $name = "$first, $second $format";
+ $name =~ s/\n/\\n/g;
+
+ my ($copy1, $copy2) = ($first, $second);
+ $first =~ /(.+)/ or die $first;
+ my $expect = "1${1}2";
+ $second =~ $re or die $second;
+ $expect .= " 3${1}4";
+
+ is swrite("1^*2 3${format}4", $copy1, $copy2), $expect, $name;
+ }
+ }
+ }
+ }
+}
format EMPTY =
.
End of Patch.
