https://gcc.gnu.org/g:c34db1ed893f309cb3a4b9e01a620423c10ca8b1
commit r17-1729-gc34db1ed893f309cb3a4b9e01a620423c10ca8b1 Author: Jerry DeLisle <[email protected]> Date: Mon Jun 15 11:58:31 2026 -0700 libfortran: [PR114618] Format produces incorrect output when contains 1x When tabbing left or right it is possible to land in the format buffer where some text is over written or skipped improperly. The bad formatting depended on whether stream I/O is used or regular I/O. The max position has to be calculated correctly in these situations. One existing test case is renamed to align with other format T/TL/TR test cases. PR libfortran/114618 libgfortran/ChangeLog: * io/transfer.c (formatted_transfer_scalar_write): Determine possible new max_pos based on file I/O method and adjust accordingly gcc/testsuite/ChangeLog: * gfortran.dg/pr114618.f90: Move to... * gfortran.dg/fmt_t_10.f90: ...here. * gfortran.dg/fmt_t_11.f90: New test. Diff: --- .../gfortran.dg/{pr114618.f90 => fmt_t_10.f90} | 4 +- gcc/testsuite/gfortran.dg/fmt_t_11.f90 | 61 ++++++++++++++++++++++ libgfortran/io/transfer.c | 23 +++++++- 3 files changed, 85 insertions(+), 3 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/pr114618.f90 b/gcc/testsuite/gfortran.dg/fmt_t_10.f90 similarity index 94% rename from gcc/testsuite/gfortran.dg/pr114618.f90 rename to gcc/testsuite/gfortran.dg/fmt_t_10.f90 index 835597b8513d..1f714d24d4e8 100644 --- a/gcc/testsuite/gfortran.dg/pr114618.f90 +++ b/gcc/testsuite/gfortran.dg/fmt_t_10.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! PR114618 Format produces incorrect output when contains 1x, ok when uses " " ! aside: Before patch output1 is garbage. -program pr114618 +program fmt_t_10 implicit none integer, parameter :: wp = kind(0d0) real(kind=wp) :: pi = 3.14159265358979323846264338_wp @@ -12,4 +12,4 @@ program pr114618 write (output2, fmt2) 'RADIX', radix(pi) if (output1 /= 'RADIX.............. 2') stop 1 if (output2 /= 'RADIX ............. 2') stop 2 -end program pr114618 +end program fmt_t_10 diff --git a/gcc/testsuite/gfortran.dg/fmt_t_11.f90 b/gcc/testsuite/gfortran.dg/fmt_t_11.f90 new file mode 100644 index 000000000000..7c4300e616b3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_t_11.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! PR libfortran/114618 - Test TL, TR, and T specifiers in combination for +! sequential and stream formatted file I/O. +program fmt_t_11 + implicit none + integer :: u + character(len=20) :: line + + ! --- Sequential formatted file tests --- + + ! T backward then TR forward into already-written content + open (newunit=u, status='scratch', form='formatted') + write (u, '(10("X"),t3,"AB",tr3,"C")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:10) /= 'XXABXXXCXX') stop 1 + + ! TL backward then TR forward into already-written content + open (newunit=u, status='scratch', form='formatted') + write (u, '("HELLO123",tl5,"AB",tr3,"Z")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:9) /= 'HELAB123Z') stop 2 + + ! T, TL, and TR all combined in one format + open (newunit=u, status='scratch', form='formatted') + write (u, '(t7,"*",tl5,"AB",tr3,"Z")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:8) /= ' AB *Z') stop 3 + + ! --- Stream formatted file tests --- + + ! T backward then TR forward into already-written content + open (newunit=u, status='scratch', form='formatted', access='stream') + write (u, '(10("X"),t3,"AB",tr3,"C")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:10) /= 'XXABXXXCXX') stop 4 + + ! TL backward then TR forward into already-written content + open (newunit=u, status='scratch', form='formatted', access='stream') + write (u, '("HELLO123",tl5,"AB",tr3,"Z")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:9) /= 'HELAB123Z') stop 5 + + ! T, TL, and TR all combined in one format + open (newunit=u, status='scratch', form='formatted', access='stream') + write (u, '(t7,"*",tl5,"AB",tr3,"Z")') + rewind (u) + read (u, '(a)') line + close (u) + if (line(1:8) /= ' AB *Z') stop 6 + +end program fmt_t_11 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index d88cd810529f..de7b6d7df35c 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -2162,7 +2162,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin } if (is_stream_io(dtp)) - bytes_used = dtp->u.p.current_unit->fbuf->act; + bytes_used = dtp->u.p.current_unit->fbuf->pos; else bytes_used = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left; @@ -2420,6 +2420,27 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin dtp->u.p.skips += f->u.n; tab_pos = bytes_used + dtp->u.p.skips - 1; dtp->u.p.pending_spaces = tab_pos - dtp->u.p.max_pos + 1; + if (dtp->u.p.pending_spaces < 0 && dtp->u.p.skips > 0) + { + /* The advance falls within already-written content (e.g. after + a backward tab). Advance the position without overwriting + the existing characters. */ + gfc_offset new_max; + write_x (dtp, dtp->u.p.skips, 0); + + /* Adjust the max position depending on the type of write. */ + if (is_stream_io (dtp)) + new_max = dtp->u.p.current_unit->fbuf->act; + else + new_max = dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left; + + dtp->u.p.max_pos = dtp->u.p.max_pos > new_max + ? dtp->u.p.max_pos : new_max; + + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + break; + } dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0 ? f->u.n : dtp->u.p.pending_spaces;
