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

backport: re PR fortran/83191 (Writing a namelist with repeated complex numbers)

Browse Source 
2017-12-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
            Dominique d'Humieres  <dominiq@lps.ens.fr>

        Backport from trunk
        PR libgfortran/83191
        * io/transfer.c (list_formatted_read_scalar): Do not set
        namelist_mode bit here. (namelist_read): Likewise.
        (data_transfer_init): Clear the mode bit here.
        (finalize_transfer): Do set the mode bit just before any calls
        to namelist_read or namelist_write. It can now be referred to
        in complex_write.
        * io/write.c (write_complex): Suppress the leading blanks when
        namelist_mode bit is not set to 1.

        * gfortran.dg/namelist_95.f90: New test.

Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>

From-SVN: r255368
This commit is contained in:
Jerry DeLisle 2017-12-03 20:43:59 +00:00
parent d8e390ad79
commit 7aee7828de
6 changed files with 50 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-12-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backported from trunk
PR fortran/83191
* gfortran.dg/namelist_95.f90: New test.
2017-11-29 Martin Jambor <mjambor@suse.cz>
PR ipa/82808

23
gcc/testsuite/gfortran.dg/namelist_95.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
! PR83191 Writing a namelist with repeated complex
program test
implicit none
integer, parameter :: UNIT = 1
character(len=8), parameter :: FILE = "namelist"
complex, dimension(3) :: a = (/ (0.0, 0.0), (0.0, 0.0), (3.0, 4.0) /)
namelist /complex_namelist/ a
open(UNIT, file=FILE)
write(UNIT, nml=complex_namelist)
close(UNIT)
open(UNIT, file=FILE)
read(UNIT, nml=complex_namelist)
close(UNIT, status="delete")
if (any(a.ne.(/ (0.0, 0.0), (0.0, 0.0), (3.0, 4.0) /))) call abort
end program test

14
libgfortran/ChangeLog
View File

@ -1,3 +1,17 @@
2017-12-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Dominique d'Humieres <dominiq@lps.ens.fr>
Backport from trunk
PR libgfortran/83191
* io/transfer.c (list_formatted_read_scalar): Do not set
namelist_mode bit here. (namelist_read): Likewise.
(data_transfer_init): Clear the mode bit here.
(finalize_transfer): Do set the mode bit just before any calls
to namelist_read or namelist_write. It can now be referred to
in complex_write.
* io/write.c (write_complex): Suppress the leading blanks when
namelist_mode bit is not set to 1.
2017-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk

3
libgfortran/io/list_read.c
View File

@ -2099,8 +2099,6 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
int c, i, m;
int err = 0;
dtp->u.p.namelist_mode = 0;
/* Set the next_char and push_char worker functions. */
set_workers (dtp);
@ -3546,7 +3544,6 @@ namelist_read (st_parameter_dt *dtp)
name. */
namelist_info *prev_nl = NULL;
dtp->u.p.namelist_mode = 1;
dtp->u.p.input_complete = 0;
dtp->u.p.expanded_read = 0;

3
libgfortran/io/transfer.c
View File

@ -2671,7 +2671,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
dtp->u.p.ionml = ionml;
dtp->u.p.mode = read_flag ? READING : WRITING;
dtp->u.p.namelist_mode = 0;
dtp->u.p.cc.len = 0;
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
@ -3889,6 +3889,7 @@ finalize_transfer (st_parameter_dt *dtp)
if ((dtp->u.p.ionml != NULL)
&& (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0)
{
dtp->u.p.namelist_mode = 1;
if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0)
namelist_read (dtp);
else

8
libgfortran/io/write.c
View File

@ -1809,9 +1809,11 @@ write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size)
precision, buf_size, result1, &res_len1);
get_float_string (dtp, &f, source + size / 2 , kind, 0, buffer,
precision, buf_size, result2, &res_len2);
lblanks = width - res_len1 - res_len2 - 3;
write_x (dtp, lblanks, lblanks);
if (!dtp->u.p.namelist_mode)
{
lblanks = width - res_len1 - res_len2 - 3;
write_x (dtp, lblanks, lblanks);
}
write_char (dtp, '(');
write_float_string (dtp, result1, res_len1);
write_char (dtp, semi_comma);