procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: Fix handling of the X edit descriptor.

Browse source 
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.
This commit is contained in:
Jerry DeLisle 2025-01-29 13:40:59 -08:00
parent 6305c46fad
commit cfed99751c
2 changed files with 64 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/testsuite/gfortran.dg/pr114618.f90 Normal file
View file

@ -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

75
libgfortran/io/transfer.c
View file

@ -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;