This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch,libgfortran] PR25631 Fix TL format when no bytes used.
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 08 Jan 2006 01:35:14 -0800
- Subject: [patch,libgfortran] PR25631 Fix TL format when no bytes used.
:ADDPATCH fortran:
The attached patch provides for the special case when a TL format specifier is
encountered before any actual data is encountered. In this case if there are
pending spaces or skips from previous format specifiers, they must be adjusted
by the amount specified in the TL.
NIST tested, regression tested, LAPACK tested.
OK for 4.1 and 4.2?
Regards,
Jerry
2006-01-08 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/25631
* io/transfer.c (formatted_transfer_scalar): Adjust pending_spaces and
skips so that TL works correctly when no bytes_used yet.
Index: io/transfer.c
===================================================================
*** io/transfer.c (revision 109465)
--- io/transfer.c (working copy)
*************** formatted_transfer_scalar (st_parameter_
*** 868,874 ****
case FMT_TL:
case FMT_T:
if (f->format == FMT_TL)
! pos = bytes_used - f->u.n;
else /* FMT_T */
{
consume_data_flag = 0;
--- 868,888 ----
case FMT_TL:
case FMT_T:
if (f->format == FMT_TL)
! {
!
! /* 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.pending_spaces = dtp->u.p.pending_spaces < 0 ? 0
! : dtp->u.p.pending_spaces;
! 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;
! }
else /* FMT_T */
{
consume_data_flag = 0;
! { dg-do run }
! PR25631 Check that TL editing works for special case of no bytes written yet.
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
real x
character*15 line
x = 12.34
write(line,10) x
10 format(tr2,tl2,g11.4)
if (line.ne.' 12.34 ') call abort()
write(line,20) x
20 format(tr5,tl3,g11.4)
if (line.ne.' 12.34 ') call abort()
write(line,30) x
30 format(tr5,tl3,tl3,g11.4)
if (line.ne.' 12.34 ') call abort()
write(line,40) x
40 format(tr25,tl35,f11.4)
if (line.ne.' 12.3400 ') call abort()
write(line,50) x
50 format(tl5,tr3,f11.4)
if (line.ne.' 12.3400 ') call abort()
write(line,60) x
60 format(t5,tl3,f11.4)
if (line.ne.' 12.3400 ') call abort()
end