From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Fri, 29 Dec 2017 19:25:31 +0000 (+0000)
Subject: re PR fortran/83560 (list-directed formatting of INTEGER is missing plus on output... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a97de3ccdce3bac856c2b10b57a49a15c94e6ef2;p=gcc.git

re PR fortran/83560 (list-directed formatting of INTEGER is missing plus on output when output open with SIGN='PLUS')

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
index 00000000000..695f9d34621
--- /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 d4fdf574e0e..9e5692abe6a 100644
--- 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 7db4c4bb83c..a110fa0d840 100644
--- 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 aa2a0f7f673..e94df2c75bd 100644
--- 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 926d510f4d7..19e53ebdeb8 100644
--- 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;