Hi,
this patch fixes PR 52512.
Built and regtested on Linux 3.2.0-4-686-pae.
Regards,
Tilo
2013-03-15 Tilo Schwarz <t...@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-15 Tilo Schwarz <t...@tilo-schwarz.de>
PR libfortran/52512
* gfortran.dg/namelist_79.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/namelist_79.f90 b/gcc/testsuite/gfortran.dg/namelist_79.f90
new file mode 100644
index 0000000..2b2ef31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_79.f90
@@ -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
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index aa7c8c0..fe591f6 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2054,8 +2054,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;
@@ -2230,7 +2230,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;
@@ -2867,7 +2867,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');
@@ -2924,8 +2924,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,