[PATCH] Fortran: Fix FMT_X/TR output into already-written content, [PR114618]

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