diff options
author | David Mitchell <davem@iabyn.com> | 2011-05-29 17:13:07 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2011-05-29 20:21:54 +0100 |
commit | f5ada144f34d75c136b6780e10ca13d18d44c557 (patch) | |
tree | c325816b8dfa40cac2dc7eb7aab9f27db841900f | |
parent | 8aa7beb669fc0c538f84c04650555a03349429da (diff) | |
download | perl-f5ada144f34d75c136b6780e10ca13d18d44c557.tar.gz |
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.
-rw-r--r-- | pp_ctl.c | 14 | ||||
-rw-r--r-- | t/op/write.t | 25 |
2 files changed, 34 insertions, 5 deletions
@@ -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 646143d529..27effdeb41 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'); |