See attached. Honestly I stared at this for hours and gave up on it more than
once since the problem first showed up. As usual, once one sees it, it is almost
obvious.
Feel free to exercise this thing since the area of tabbing has been so
troublesome.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
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.
commit ac094c19c8537037f823be080225e5f511fc56f4
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 --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 835597b8513..1f714d24d4e 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 00000000000..7c4300e616b
--- /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 d88cd810529..de7b6d7df35 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;
