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

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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 36552cc29c261eb1b20471f3392229ae95591855..aa2274fc701dbffcf9b100298abad291516cb649 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/namelist_79.f90 b/gcc/testsuite/gfortran.dg/namelist_79.f90
new file mode 100644 (file)
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/ChangeLog b/libgfortran/ChangeLog
index 865725fbffa07b63d342b9a4b0480a91bbdf151a..61c9fd10c636d3ab4732710d18b86c8347e73dfd 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index e7ae98fcf282080e0f0cc6b724d1548d92d2ba82..ec4557002687607ab3a5568db55b342854118fee 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -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,