See attached patch which cleans up I hope the last of the tabbing issues in
formatted output. I renamed the existing test case and created a new one to
test several variations.
Comments appreciated.
Regression tested on X86_64.
Ok for mainline? No plans to backport unless someone thinks its needed.
Best regards,
Jerry
---
When an X or TR edit descriptor advances the file position into
content that has already been written (e.g. after a backward T or
TL tab), formatted_transfer_scalar_write either corrupted the
pending_spaces accounting or overwrote the existing characters with
blanks.
Fix this by detecting the case where pending_spaces is negative and
skips is positive (the advance falls within already-written content)
and using write_x (skips, 0) to move the file position forward
without overwriting. Also, for stream I/O, compute bytes_used from
fbuf->pos (the current write position) rather than fbuf->act (the
high-water mark), since the two diverge after a backward tab followed
by a partial overwrite, which previously prevented this case from
being detected for stream units.
Assisted by: Claude Sonnet 4.6
PR libfortran/114618
libgfortran/ChangeLog:
* io/transfer.c (formatted_transfer_scalar_write): Use
fbuf->pos rather than fbuf->act for bytes_used with stream
I/O. When pending_spaces is negative and skips is positive,
advance the position with write_x (skips, 0) instead of
overwriting existing content.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr114618.f90: Move to...
* gfortran.dg/fmt_t_10.f90: ...here.
* gfortran.dg/fmt_t_11.f90: New test.
---From c01c6cc8ae57f13bbd8185144760b24d73db7e84 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sun, 14 Jun 2026 21:28:32 -0700
Subject: [PATCH] Fortran: Fix FMT_X/TR output into already-written content
[PR114618]
When an X or TR edit descriptor advances the file position into
content that has already been written (e.g. after a backward T or
TL tab), formatted_transfer_scalar_write either corrupted the
pending_spaces accounting or overwrote the existing characters with
blanks.
Fix this by detecting the case where pending_spaces is negative and
skips is positive (the advance falls within already-written content)
and using write_x (skips, 0) to move the file position forward
without overwriting. Also, for stream I/O, compute bytes_used from
fbuf->pos (the current write position) rather than fbuf->act (the
high-water mark), since the two diverge after a backward tab followed
by a partial overwrite, which previously prevented this case from
being detected for stream units.
Assisted by: Claude Sonnet 4.6
PR libfortran/114618
libgfortran/ChangeLog:
* io/transfer.c (formatted_transfer_scalar_write): Use
fbuf->pos rather than fbuf->act for bytes_used with stream
I/O. When pending_spaces is negative and skips is positive,
advance the position with write_x (skips, 0) instead of
overwriting existing content.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr114618.f90: Move to...
* gfortran.dg/fmt_t_10.f90: ...here.
* gfortran.dg/fmt_t_11.f90: New test.
---
.../{pr114618.f90 => fmt_t_10.f90} | 4 +-
gcc/testsuite/gfortran.dg/fmt_t_11.f90 | 61 +++++++++++++++++++
libgfortran/io/transfer.c | 19 +++++-
3 files changed, 81 insertions(+), 3 deletions(-)
rename gcc/testsuite/gfortran.dg/{pr114618.f90 => fmt_t_10.f90} (94%)
create mode 100644 gcc/testsuite/gfortran.dg/fmt_t_11.f90
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..f15ca04ed30 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,23 @@ 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 tmp;
+ write_x (dtp, dtp->u.p.skips, 0);
+ if (is_stream_io (dtp))
+ tmp = dtp->u.p.current_unit->fbuf->act;
+ else
+ tmp = dtp->u.p.current_unit->recl
+ - dtp->u.p.current_unit->bytes_left;
+ dtp->u.p.max_pos = dtp->u.p.max_pos > tmp
+ ? dtp->u.p.max_pos : tmp;
+ 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;
--
2.54.0
