From 64c759edc665580f86c645a74eefab8ffcfed8be Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 28 Apr 2013 16:50:19 +0000 Subject: [PATCH] backport: re PR fortran/52512 (Cannot match namelist object name) 2013-04-28 Jerry DeLisle Backport from mainline: 2013-03-25 Tilo Schwarz 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 Backport from trunk: PR fortran/52512 * gfortran.dg/namelist_79.f90: New test. From-SVN: r198373 --- gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gfortran.dg/namelist_79.f90 | 43 +++++++++++++++++++++++ libgfortran/ChangeLog | 11 ++++++ libgfortran/io/list_read.c | 12 +++---- 4 files changed, 67 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/namelist_79.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8a237420abf5..7b67c65c04e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2013-04-28 Jerry DeLisle + + Backport from trunk: + + PR fortran/52512 + * gfortran.dg/namelist_79.f90: New test. + 2013-04-27 Jakub Jelinek PR target/56866 diff --git a/gcc/testsuite/gfortran.dg/namelist_79.f90 b/gcc/testsuite/gfortran.dg/namelist_79.f90 new file mode 100644 index 000000000000..2b2ef310d093 --- /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/ChangeLog b/libgfortran/ChangeLog index d0e034d4791f..759ca5df6bef 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2013-04-28 Jerry DeLisle + + Backport from mainline: + 2013-03-25 Tilo Schwarz + + 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. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index efb43f872a03..42c984ba0f27 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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'); -- 2.47.2