Commit a97de3cc by Jerry DeLisle

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

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
parent 459e77b8
! { 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
...@@ -5,5 +5,5 @@ ...@@ -5,5 +5,5 @@
n = 123 n = 123
line = "" line = ""
write(line,nml=stuff) write(line,nml=stuff)
if (line.ne."&STUFF N= 123, /") call abort if (line.ne."&STUFF N=123 , /") print *, line
end end
...@@ -7,6 +7,6 @@ ...@@ -7,6 +7,6 @@
line = "" line = ""
write(line,nml=stuff) write(line,nml=stuff)
if (line(1) .ne. "&STUFF") call abort 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 if (line(3) .ne. " /") call abort
end end
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> 2017-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/81937 PR libgfortran/81937
......
...@@ -870,8 +870,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ...@@ -870,8 +870,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
goto done; goto done;
} }
memset4 (p4, ' ', nblank); if (!dtp->u.p.namelist_mode)
p4 += nblank; {
memset4 (p4, ' ', nblank);
p4 += nblank;
}
switch (sign) switch (sign)
{ {
...@@ -890,6 +893,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ...@@ -890,6 +893,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
memcpy4 (p4, q, digits); memcpy4 (p4, q, digits);
return; return;
if (dtp->u.p.namelist_mode)
{
p4 += digits;
memset4 (p4, ' ', nblank);
}
} }
if (nblank < 0) if (nblank < 0)
...@@ -898,8 +907,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ...@@ -898,8 +907,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
goto done; goto done;
} }
memset (p, ' ', nblank); if (!dtp->u.p.namelist_mode)
p += nblank; {
memset (p, ' ', nblank);
p += nblank;
}
switch (sign) switch (sign)
{ {
...@@ -918,6 +930,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ...@@ -918,6 +930,12 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
memcpy (p, q, digits); memcpy (p, q, digits);
if (dtp->u.p.namelist_mode)
{
p += digits;
memset (p, ' ', nblank);
}
done: done:
return; return;
} }
...@@ -1300,17 +1318,12 @@ write_logical (st_parameter_dt *dtp, const char *source, int length) ...@@ -1300,17 +1318,12 @@ write_logical (st_parameter_dt *dtp, const char *source, int length)
/* Write a list-directed integer value. */ /* Write a list-directed integer value. */
static void 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; 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: case 1:
width = 4; width = 4;
...@@ -1332,41 +1345,9 @@ write_integer (st_parameter_dt *dtp, const char *source, int length) ...@@ -1332,41 +1345,9 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
width = 0; width = 0;
break; break;
} }
f.u.integer.w = width;
digits = strlen (q); f.u.integer.m = -1;
write_decimal (dtp, &f, source, kind, (void *) gfc_itoa);
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);
}
} }
...@@ -2254,7 +2235,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset, ...@@ -2254,7 +2235,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
dtp->u.p.current_unit->child_dtio++; dtp->u.p.current_unit->child_dtio++;
if (obj->type == BT_DERIVED) if (obj->type == BT_DERIVED)
{ {
// build a class container /* Build a class container. */
gfc_class list_obj; gfc_class list_obj;
list_obj.data = p; list_obj.data = p;
list_obj.vptr = obj->vtable; list_obj.vptr = obj->vtable;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment