OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Jerry DeLisle 2017-12-29 19:25:31 +00:00
parent 459e77b859
commit a97de3ccdc
5 changed files with 51 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/testsuite/gfortran.dg/integer_plus.f90 Normal file
View File

@ -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

2
gcc/testsuite/gfortran.dg/namelist_53.f90
View File

@ -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

2
gcc/testsuite/gfortran.dg/namelist_57.f90
View File

@ -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

8
libgfortran/ChangeLog
View File

@ -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

77
libgfortran/io/write.c
View File

@ -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];
fnode f;
q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf));
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;