Re: [patch, lingfortran] Bug 83560 - list-directed formatting of INTEGER is missing plus on output

[Jerry DeLisle <jvdelisle at charter dot net>]

On 12/25/2017 12:06 PM, Jerry DeLisle wrote:
> On 12/25/2017 05:10 AM, Dominique d'Humières wrote:
>> Dear Jerry,
>>
>> The lines
>>
>> +a=12.3456
>>
>> and
>>
>> +open(unit=10,sign='plus')
>>
>> in gfortran.dg/integer_plus.f90 could probably be removed.
>>
> 
> Yes, left over from some other testing I was doing
> 
>> From comment 2 in the PR (and the attached test), it seems that the reporter is expecting sign=‘plus’ to apply also to namelists, which is not the case with this patch.
>>
>> This seems supported by (my understanding of)
>>
>>> 10.11.4.2 Namelist output editing
>>>
>>> 1 Values in namelist output records are edited as for list-directed output (10.10.4).
>>
>> Merry Christmas!
>>
>> Dominique
>>
>>
> 
> What I did last night made perfect sense at the time. Now, your point well
> taken. The previous write_integer suppressed leading spaces nicely for writing
> repeat counts, write_decimal does not do this directly. I am going to have to be
> careful we don't put plus signs on repeat counts.
> 
> Merry Christmas to you and all!
> 
> Jerry

The attached patch adds the "plus" functionality to namelist writes. I had to
adjust write_decimal to not emit leading blanks and instead make them trailing
(in namelist mode). Our namelist read functions do not like spaces between the
repeat symbol and the plus sign. This required minor modification to two test
cases.  I got rid of the namelist_write_integer from my previous patch.

(I will do testsuite ChangeLog at time of commit.

Regression tested on x86_64-pc-linux-gnu.

OK for trunk?

Jerry

2017-12-28  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.


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