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 <jvdeli...@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.
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:
