diff mbox series

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

Message ID 645f227c-aed5-c143-2b4d-4b093a79ae65@charter.net
State New
Headers show
Series [lingfortran] Bug 83560 - list-directed formatting of INTEGER is missing plus on output | expand

Commit Message

Jerry DeLisle Dec. 25, 2017, 4:02 a.m. UTC 
Attached patch changes the use of write_integer for the test case which uses the
sign='plus' specifier when opening a file and using list directed output. To
fix, I used the write decimal function for namelist writes. For compatibility, I
used the content of the previous write_integer function in a new function
namelist_write_integer.

Regression tested on x86_64-pc-linux.

OK for trunk?

Regards,

Jerry

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

	PR libgfortran/83560
	* io/write.c (write_integer): Modify to use write_decimal.
	Change paramter from len to kind to be better understood.
	(namelist_write_integer): New function based on previous
	write_integer. (nml_write_obj): Use namelist_write_integer
	instead of write_integer.

Comments

Jerry DeLisle Dec. 25, 2017, 4:06 a.m. UTC | #1 
Correction, I used write_decimal for everything except namelist writes.

On 12/24/2017 08:02 PM, Jerry DeLisle wrote:
> Attached patch changes the use of write_integer for the test case which uses the
> sign='plus' specifier when opening a file and using list directed output. To
> fix, I used the write decimal function for namelist writes. For compatibility, I
> used the content of the previous write_integer function in a new function
> namelist_write_integer.
> 
> Regression tested on x86_64-pc-linux.
> 
> OK for trunk?
> 
> Regards,
> 
> Jerry
> 
> 2017-12-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
> 
> 	PR libgfortran/83560
> 	* io/write.c (write_integer): Modify to use write_decimal.
> 	Change paramter from len to kind to be better understood.
> 	(namelist_write_integer): New function based on previous
> 	write_integer. (nml_write_obj): Use namelist_write_integer
> 	instead of write_integer.
>
Thomas Koenig Dec. 25, 2017, 12:59 p.m. UTC | #2 
Hi Jerry,

> OK for trunk?

OK. Thanks for the patch.

And: Merry Christmas to everybody!

	Thomas
diff mbox series

Patch

diff --git a/gcc/testsuite/gfortran.dg/integer_plus.f90 b/gcc/testsuite/gfortran.dg/integer_plus.f90
new file mode 100644
index 00000000000..47f5aa88f17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_plus.f90
@@ -0,0 +1,14 @@ 
+! { dg-run run )
+! PR83560 list-directed formatting of INTEGER is missing plus on output
+! when output open with SIGN='PLUS'
+character(64) :: astring
+a=12.3456
+i=789
+open(unit=10, status='scratch', sign='plus')
+open(unit=10,sign='plus')
+write(10,*) i
+rewind(10)
+read(10,*) astring
+close (10)
+if (astring.ne.'+789') call abort
+end
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 926d510f4d7..3efe60c12a7 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1300,17 +1300,16 @@  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];
+  fnode f;
 
-  q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf));
-
-  switch (length)
+  switch (kind)
     {
     case 1:
       width = 4;
@@ -1332,41 +1331,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);
 }
 
 
@@ -1984,6 +1951,76 @@  list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind,
 
 #define NML_DIGITS 20
 
+static void
+namelist_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, kind), itoa_buf, sizeof (itoa_buf));
+
+  switch (kind)
+    {
+    case 1:
+      width = 4;
+      break;
+
+    case 2:
+      width = 6;
+      break;
+
+    case 4:
+      width = 11;
+      break;
+
+    case 8:
+      width = 20;
+      break;
+
+    default:
+      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);
+    }
+}
+
 static void
 namelist_write_newline (st_parameter_dt *dtp)
 {
@@ -2183,7 +2220,7 @@  nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
 	    {
 
 	    case BT_INTEGER:
-	      write_integer (dtp, p, len);
+	      namelist_write_integer (dtp, p, len);
               break;
 
 	    case BT_LOGICAL: