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;
} );
switch (*fpc++) {
case FF_LINEMARK:
- linemark = t;
+ linemark = t - SvPVX(PL_formtarget);
lines++;
gotsome = FALSE;
break;
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);
case FF_NEWLINE:
f++;
- while (t-- > linemark && *t == ' ') ;
+ while (t-- > (SvPVX(PL_formtarget) + linemark) && *t == ' ') ;
t++;
*t++ = '\n';
break;
}
}
else {
- t = linemark;
+ t = SvPVX(PL_formtarget) + linemark;
lines--;
}
break;
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;
}
}
+# 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');