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

re PR fortran/52512 (Cannot match namelist object name)

Browse Source 
2013-03-25  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/52512
        * io/list_read.c (nml_parse_qualifier): To check for a derived type
        don't use the namelist head element type but the current element type.
        (nml_get_obj_data): Add current namelist element type to
        nml_parse_qualifier call.

2013-03-25  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/52512
        * gfortran.dg/namelist_79.f90: New.

From-SVN: r197061
This commit is contained in:
Tilo Schwarz 2013-03-25 20:11:20 +00:00 committed by Tilo Schwarz
parent 39e4565357
commit 6f6fafc9ef
4 changed files with 62 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-03-25 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/52512
* gfortran.dg/namelist_79.f90: New.
2013-03-25 Martin Jambor <mjambor@suse.cz>
* gcc.dg/ipa/ipcp-agg-9.c: New test.

43
gcc/testsuite/gfortran.dg/namelist_79.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
! PR libfortran/52512 - Cannot match namelist object name
! Test case derived from PR.
program testje
implicit none
integer :: getal, jn
type ptracer
character(len = 8) :: sname !: short name
logical :: lini !: read in a file or not
end type ptracer
type(ptracer) , dimension(3) :: tracer
namelist/namtoptrc/ getal,tracer
! standard values
getal = 9999
do jn = 1, 3
tracer(jn)%sname = 'default_name'
tracer(jn)%lini = .false.
end do
open (10, status='scratch')
write (10, '(a)') "&namtoptrc"
write (10, '(a)') " getal = 7"
write (10, '(a)') " tracer(1) = 'DIC ', .true."
write (10, '(a)') " tracer(2) = 'Alkalini', .true."
write (10, '(a)') " tracer(3) = 'O2 ', .true."
write (10, '(a)') "/"
rewind(10)
read(10, nml=namtoptrc)
close (10)
if (getal /= 7) call abort
if (tracer(1)%sname /= 'DIC ') call abort
if (tracer(2)%sname /= 'Alkalini') call abort
if (tracer(3)%sname /= 'O2 ') call abort
if (.not. tracer(1)%lini) call abort
if (.not. tracer(2)%lini) call abort
if (.not. tracer(3)%lini) call abort
end program testje

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2013-03-25 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/52512
* io/list_read.c (nml_parse_qualifier): To check for a derived type
don't use the namelist head element type but the current element type.
(nml_get_obj_data): Add current namelist element type to
nml_parse_qualifier call.
2013-03-24 Tobias Burnus <burnus@net-b.de>
PR fortran/56696

12
libgfortran/io/list_read.c
View File

@ -2053,8 +2053,8 @@ calls:
static bool
nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
array_loop_spec *ls, int rank, char *parse_err_msg,
size_t parse_err_msg_size,
array_loop_spec *ls, int rank, bt nml_elem_type,
char *parse_err_msg, size_t parse_err_msg_size,
int *parsed_rank)
{
int dim;
@ -2229,7 +2229,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
do not allow excess data to be processed. */
if (is_array_section == 1
|| !(compile_options.allow_std & GFC_STD_GNU)
|| dtp->u.p.ionml->type == BT_DERIVED)
|| nml_elem_type == BT_DERIVED)
ls[dim].end = ls[dim].start;
else
dtp->u.p.expanded_read = 1;
@ -2866,7 +2866,7 @@ get_name:
{
parsed_rank = 0;
if (!nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
nml_err_msg, nml_err_msg_size,
nl->type, nml_err_msg, nml_err_msg_size,
&parsed_rank))
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
@ -2923,8 +2923,8 @@ get_name:
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
if (!nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg,
nml_err_msg_size, &parsed_rank))
if (!nml_parse_qualifier (dtp, chd, ind, -1, nl->type,
nml_err_msg, nml_err_msg_size, &parsed_rank))
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
snprintf (nml_err_msg_end,