backport: re PR fortran/52512 (Cannot match namelist object name)
2013-04-28 Jerry DeLisle <jvdelisle@gcc.gnu.org> Backport from mainline: 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-04-28 Jerry DeLisle <jvdelisle@gcc.gnu.org> Backport from trunk: PR fortran/52512 * gfortran.dg/namelist_79.f90: New test. From-SVN: r198373
This commit is contained in:
parent
4ec4a9b309
commit
64c759edc6
|
@ -1,3 +1,10 @@
|
|||
2013-04-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
Backport from trunk:
|
||||
|
||||
PR fortran/52512
|
||||
* gfortran.dg/namelist_79.f90: New test.
|
||||
|
||||
2013-04-27 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR target/56866
|
||||
|
|
|
@ -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
|
|
@ -1,3 +1,14 @@
|
|||
2013-04-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
Backport from mainline:
|
||||
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-04-11 Release Manager
|
||||
|
||||
* GCC 4.7.3 released.
|
||||
|
|
|
@ -2028,8 +2028,8 @@ calls:
|
|||
|
||||
static try
|
||||
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;
|
||||
|
@ -2204,7 +2204,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;
|
||||
|
@ -2842,7 +2842,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) == FAILURE)
|
||||
{
|
||||
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
|
||||
|
@ -2898,8 +2898,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)
|
||||
== FAILURE)
|
||||
{
|
||||
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
|
||||
|
|
Loading…
Reference in New Issue