The attached patch I had to redo because I was asked to no longer use LLM for
assistance until the gcc LLM Working Group comes up with a policy. I dont know
when that might happen so I am not using LLM at the moment.
This patch reworked by myself and retested on X86_64. I have no plans to
backport this.
Ok for mainline?
Best regards,
Jerry
---
commit fb37c5b7548faf3094ccae9aa8f187cb3277fc20
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.
---commit fb37c5b7548faf3094ccae9aa8f187cb3277fc20
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;
