re PR fortran/83560 (list-directed formatting of INTEGER is missing plus on output...

2017-12-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

        PR libgfortran/83560
        * io/write.c (write_integer): Modify to use write_decimal.
        For namelist mode, suppress leading blanks and emit them as
        trailing blanks. Change parameter from len to kind for better
        readability. (nml_write_obj): Fix comment style.

From-SVN: r256034

diff --git a/gcc/testsuite/gfortran.dg/integer_plus.f90 b/gcc/testsuite/gfortran.dg/integer_plus.f90
new file mode 100644 (file)
index 0000000..695f9d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_plus.f90
@@ -0,0 +1,12 @@
+! { dg-run run )
+! PR83560 list-directed formatting of INTEGER is missing plus on output
+! when output open with SIGN='PLUS'
+character(64) :: astring
+i=789
+open(unit=10, status='scratch', sign='plus')
+write(10,*) i
+rewind(10)
+read(10,*) astring
+close (10)
+if (astring.ne.'+789') call abort
+end

diff --git a/gcc/testsuite/gfortran.dg/namelist_53.f90 b/gcc/testsuite/gfortran.dg/namelist_53.f90
index d4fdf574e0e97af103ba88f9bfb12e6c704f592d..9e5692abe6aa6f38a9358a8597afbe2045db2f31 100644 (file)
--- a/gcc/testsuite/gfortran.dg/namelist_53.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_53.f90
@@ -5,5 +5,5 @@
   n = 123
   line = ""
   write(line,nml=stuff)
-  if (line.ne."&STUFF  N=        123,  /") call abort
+  if (line.ne."&STUFF  N=123        ,  /") print *, line
   end 

diff --git a/gcc/testsuite/gfortran.dg/namelist_57.f90 b/gcc/testsuite/gfortran.dg/namelist_57.f90
index 7db4c4bb83c16ea94963026edb78c5465c87fb00..a110fa0d840559282cef258f76d35a9cd1041631 100644 (file)
--- a/gcc/testsuite/gfortran.dg/namelist_57.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_57.f90
@@ -7,6 +7,6 @@
   line = ""
   write(line,nml=stuff)
   if (line(1) .ne. "&STUFF") call abort
-  if (line(2) .ne. " N=        123,") call abort
+  if (line(2) .ne. " N=123        ,") call abort
   if (line(3) .ne. " /") call abort
   end 

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index aa2a0f7f673d9b46cbb90b459f490a98ededc820..e94df2c75bd76b802b83ab4ddc007f62b2594925 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2017-12-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/83560
+       * io/write.c (write_integer): Modify to use write_decimal.
+       For namelist mode, suppress leading blanks and emit them as
+       trailing blanks. Change parameter from len to kind for better
+       readability. (nml_write_obj): Fix comment style.
+
 2017-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/81937

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 926d510f4d7c148504e2661b40699af3242f1247..19e53ebdeb8925c0a724663df79250ee263ce858 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -870,8 +870,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
          goto done;
        }
 
-      memset4 (p4, ' ', nblank);
-      p4 += nblank;
+      if (!dtp->u.p.namelist_mode)
+       {
+         memset4 (p4, ' ', nblank);
+         p4 += nblank;
+       }
 
       switch (sign)
        {
@@ -890,6 +893,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
 
       memcpy4 (p4, q, digits);
       return;
+
+      if (dtp->u.p.namelist_mode)
+       {
+         p4 += digits;
+         memset4 (p4, ' ', nblank);
+       }
     }
 
   if (nblank < 0)
@@ -898,8 +907,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
       goto done;
     }
 
-  memset (p, ' ', nblank);
-  p += nblank;
+  if (!dtp->u.p.namelist_mode)
+    {
+      memset (p, ' ', nblank);
+      p += nblank;
+    }
 
   switch (sign)
     {
@@ -918,6 +930,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
 
   memcpy (p, q, digits);
 
+  if (dtp->u.p.namelist_mode)
+    {
+      p += digits;
+      memset (p, ' ', nblank);
+    }
+
  done:
   return;
 }
@@ -1300,17 +1318,12 @@ write_logical (st_parameter_dt *dtp, const char *source, int length)
 /* Write a list-directed integer value.  */
 
 static void
-write_integer (st_parameter_dt *dtp, const char *source, int length)
+write_integer (st_parameter_dt *dtp, const char *source, int kind)
 {
-  char *p;
-  const char *q;
-  int digits;
   int width;
-  char itoa_buf[GFC_ITOA_BUF_SIZE];
-
-  q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf));
+  fnode f;
 
-  switch (length)
+  switch (kind)
     {
     case 1:
       width = 4;
@@ -1332,41 +1345,9 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
       width = 0;
       break;
     }
-
-  digits = strlen (q);
-
-  if (width < digits)
-    width = digits;
-  p = write_block (dtp, width);
-  if (p == NULL)
-    return;
-
-  if (unlikely (is_char4_unit (dtp)))
-    {
-      gfc_char4_t *p4 = (gfc_char4_t *) p;
-      if (dtp->u.p.no_leading_blank)
-       {
-         memcpy4 (p4, q, digits);
-         memset4 (p4 + digits, ' ', width - digits);
-       }
-      else
-       {
-         memset4 (p4, ' ', width - digits);
-         memcpy4 (p4 + width - digits, q, digits);
-       }
-      return;
-    }
-
-  if (dtp->u.p.no_leading_blank)
-    {
-      memcpy (p, q, digits);
-      memset (p + digits, ' ', width - digits);
-    }
-  else
-    {
-      memset (p, ' ', width - digits);
-      memcpy (p + width - digits, q, digits);
-    }
+  f.u.integer.w = width;
+  f.u.integer.m = -1;
+  write_decimal (dtp, &f, source, kind, (void *) gfc_itoa);
 }
 
 
@@ -2254,7 +2235,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
                  dtp->u.p.current_unit->child_dtio++;
                  if (obj->type == BT_DERIVED)
                    {
-                     // build a class container
+                     /* Build a class container.  */
                      gfc_class list_obj;
                      list_obj.data = p;
                      list_obj.vptr = obj->vtable;