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 --git a/gcc/testsuite/gfortran.dg/pr114618.f90 b/gcc/testsuite/gfortran.dg/pr114618.f90
new file mode 100644 (file)
index 0000000..835597b
--- /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 b3b72f39c5b1fd050cd608137afd6cc381b98465..3fc53938b4a23b8806da4b37f5e81cc5b66432dd 100644 (file)
--- 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;