https://gcc.gnu.org/g:cfed99751c1a3b93ca66451eb1b62271e682f927
commit r15-7394-gcfed99751c1a3b93ca66451eb1b62271e682f927
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Wed Jan 29 13:40:59 2025 -0800
Fortran: Fix handling of the X edit descriptor.
This patch is a partial fix of handling of X edit descriptors
when combined with certain T edit descriptors.
PR libfortran/114618
libgfortran/ChangeLog:
* io/transfer.c (formatted_transfer_scalar_write): Change name
of vriable 'pos' to 'tab_pos' to improve clarity. Add new
variable next_pos when calculating the maximum position.
Update the calculation of pending spaces.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr114618.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/pr114618.f90 | 15 +++++++
libgfortran/io/transfer.c | 75 ++++++++++++++++++++++------------
2 files changed, 64 insertions(+), 26 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr114618.f90
b/gcc/testsuite/gfortran.dg/pr114618.f90
new file mode 100644
index 000000000000..835597b8513d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114618.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR114618 Format produces incorrect output when contains 1x, ok when uses " "
+! aside: Before patch output1 is garbage.
+program pr114618
+ implicit none
+ integer, parameter :: wp = kind(0d0)
+ real(kind=wp) :: pi = 3.14159265358979323846264338_wp
+ character(len=*), parameter:: fmt1 = '(19("."),t1,g0,1x,t21,g0)'
+ character(len=*), parameter:: fmt2 = '(19("."),t1,g0," ",t21,g0)'
+ character(21) :: output1, output2
+ write (output1, fmt1) 'RADIX', radix(pi)
+ write (output2, fmt2) 'RADIX', radix(pi)
+ if (output1 /= 'RADIX.............. 2') stop 1
+ if (output2 /= 'RADIX ............. 2') stop 2
+end program pr114618
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b3b72f39c5b1..3fc53938b4a2 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2068,12 +2068,14 @@ static void
formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int
kind,
size_t size)
{
- gfc_offset pos, bytes_used;
+ gfc_offset tab_pos, bytes_used;
const fnode *f;
format_token t;
int n;
int consume_data_flag;
+ tab_pos = 0; bytes_used = 0;
+
/* Change a complex data item into a pair of reals. */
n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2);
@@ -2398,10 +2400,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp,
bt type, void *p, int kin
case FMT_X:
case FMT_TR:
consume_data_flag = 0;
-
dtp->u.p.skips += f->u.n;
- pos = bytes_used + dtp->u.p.skips - 1;
- dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1;
+ tab_pos = bytes_used + dtp->u.p.skips - 1;
+ dtp->u.p.pending_spaces = tab_pos - dtp->u.p.max_pos + 1;
+ dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0
+ ? f->u.n : dtp->u.p.pending_spaces;
+
/* Writes occur just before the switch on f->format, above, so
that trailing blanks are suppressed, unless we are doing a
non-advancing write in which case we want to output the blanks
@@ -2414,35 +2418,50 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp,
bt type, void *p, int kin
break;
case FMT_TL:
- case FMT_T:
consume_data_flag = 0;
-
- if (f->format == FMT_TL)
+ /* Handle the special case when no bytes have been used yet.
+ Cannot go below zero. */
+ if (bytes_used == 0)
{
-
- /* Handle the special case when no bytes have been used yet.
- Cannot go below zero. */
- if (bytes_used == 0)
- {
- dtp->u.p.pending_spaces -= f->u.n;
- dtp->u.p.skips -= f->u.n;
- dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips;
- }
-
- pos = bytes_used - f->u.n;
+ dtp->u.p.pending_spaces -= f->u.n;
+ dtp->u.p.skips -= f->u.n;
+ dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips;
}
- else /* FMT_T */
- pos = f->u.n - dtp->u.p.pending_spaces - 1;
+
+ tab_pos = bytes_used - f->u.n;
/* Standard 10.6.1.1: excessive left tabbing is reset to the
left tab limit. We do not check if the position has gone
beyond the end of record because a subsequent tab could
bring us back again. */
- pos = pos < 0 ? 0 : pos;
+ tab_pos = tab_pos < 0 ? 0 : tab_pos;
- dtp->u.p.skips = dtp->u.p.skips + pos - bytes_used;
+ dtp->u.p.skips = dtp->u.p.skips + tab_pos - bytes_used;
dtp->u.p.pending_spaces = dtp->u.p.pending_spaces
- + pos - dtp->u.p.max_pos;
+ + tab_pos - dtp->u.p.max_pos;
+ dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0
+ ? 0 : dtp->u.p.pending_spaces;
+ break;
+
+ case FMT_T:
+ consume_data_flag = 0;
+ if (f->u.n < tab_pos + 1)
+ {
+ tab_pos = f->u.n;
+ dtp->u.p.skips = tab_pos - bytes_used - 1;
+ dtp->u.p.pending_spaces = tab_pos - bytes_used - 1;
+ }
+ else
+ {
+ tab_pos = f->u.n - dtp->u.p.pending_spaces - 1;
+
+ /* Excessive left tabbing is reset to the left tab limit. */
+ tab_pos = tab_pos < 0 ? 0 : tab_pos;
+
+ dtp->u.p.skips = dtp->u.p.skips + tab_pos - bytes_used;
+ dtp->u.p.pending_spaces = dtp->u.p.pending_spaces
+ + tab_pos - dtp->u.p.max_pos;
+ }
dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0
? 0 : dtp->u.p.pending_spaces;
break;
@@ -2550,12 +2569,16 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp,
bt type, void *p, int kin
p = ((char *) p) + size;
}
+ /* Calculate the new max_pos if any. */
+ gfc_offset new_pos;
if (is_stream_io(dtp))
- pos = dtp->u.p.current_unit->fbuf->act;
+ new_pos = dtp->u.p.current_unit->fbuf->act;
else
- pos = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
+ new_pos = dtp->u.p.current_unit->recl
+ - dtp->u.p.current_unit->bytes_left;
- dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos;
+ dtp->u.p.max_pos = (dtp->u.p.max_pos > new_pos) ?
+ dtp->u.p.max_pos : new_pos;
}
return;
