2013-04-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	Backport from mainline:
	2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>

	PR libfortran/51825
	* io/list_read.c (nml_read_obj): Don't end the component loop on a
	nested derived type, but continue with the next loop iteration.
	(nml_get_obj_data): Don't move the first_nl pointer further in the
	list if a qualifier was found.

	PR fortran/51825
	* gfortran.dg/namelist_77.f90: New test.
	* gfortran.dg/namelist_78.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@198386 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9321fce..ec94684 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -2,6 +2,14 @@
 
        Backport from trunk:
 
 
        Backport from trunk:
 

+       PR fortran/51825
+       * gfortran.dg/namelist_77.f90: New test.
+       * gfortran.dg/namelist_78.f90: New test.
+
+2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       Backport from trunk:
+

        PR fortran/56786
        * gfortran.dg/namelist_81.f90:  New test.
 
        PR fortran/56786
        * gfortran.dg/namelist_81.f90:  New test.
 

diff --git a/gcc/testsuite/gfortran.dg/namelist_77.f90 b/gcc/testsuite/gfortran.dg/namelist_77.f90
new file mode 100644 (file)
index 0000000..5cbfe3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_77.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! PR libfortran/51825 - Fortran runtime error: Cannot match namelist object name
+! Test case derived from PR.
+
+module local_mod
+
+    type mytype1
+        integer :: int1
+    end type
+
+    type mytype2
+        integer :: n_x       
+        integer :: n_px        
+    end type
+
+    type beam_init_struct
+        character(16) :: chars(1) = ''                                  
+        type (mytype1) dummy
+        type (mytype2) grid(1)      
+    end type
+
+end module
+
+program error_namelist
+
+    use local_mod
+
+    implicit none
+
+    type (beam_init_struct) beam_init
+
+    namelist / error_params / beam_init
+
+    open (10, status='scratch')
+    write (10, '(a)') "&error_params"
+    write (10, '(a)') "  beam_init%chars(1)='JUNK'"
+    write (10, '(a)') "  beam_init%grid(1)%n_x=3"
+    write (10, '(a)') "  beam_init%grid(1)%n_px=2"
+    write (10, '(a)') "/"
+    rewind(10)
+    read(10, nml=error_params)
+    close (10)
+
+    if (beam_init%chars(1) /= 'JUNK') call abort
+    if (beam_init%grid(1)%n_x /= 3) call abort
+    if (beam_init%grid(1)%n_px /= 2) call abort
+
+end program

diff --git a/gcc/testsuite/gfortran.dg/namelist_78.f90 b/gcc/testsuite/gfortran.dg/namelist_78.f90
new file mode 100644 (file)
index 0000000..d4e29ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_78.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR libfortran/51825
+! Test case regarding namelist problems with derived types
+
+program namelist
+
+    type d1
+        integer :: j = 0
+    end type d1
+
+    type d2
+        type(d1) k
+    end type d2
+
+    type d3
+        type(d2) d(2)
+    end type d3
+
+    type(d3) der
+    namelist /nmlst/ der
+
+    open (10, status='scratch')
+    write (10, '(a)') "&NMLST"
+    write (10, '(a)') " DER%D(1)%K%J = 1,"
+    write (10, '(a)') " DER%D(2)%K%J = 2,"
+    write (10, '(a)') "/"
+    rewind(10)
+    read(10, nml=nmlst)
+    close (10)
+
+    if (der%d(1)%k%j /= 1) call abort
+    if (der%d(2)%k%j /= 2) call abort
+end program namelist

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c02d6d5..7b1cda1 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,6 +1,17 @@
 2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        Backport from mainline:
 2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        Backport from mainline:

+       2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>
+
+       PR libfortran/51825
+       * io/list_read.c (nml_read_obj): Don't end the component loop on a
+       nested derived type, but continue with the next loop iteration.
+       (nml_get_obj_data): Don't move the first_nl pointer further in the
+       list if a qualifier was found.
+
+2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       Backport from mainline:

 
        PR libfortran/56786
        * io/list_read.c (nml_parse_qualifier): Remove spurious next_char call
 
        PR libfortran/56786
        * io/list_read.c (nml_parse_qualifier): Remove spurious next_char call

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index d0e83ab..e44cc14 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2561,17 +2561,17 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
               since a single object can have multiple reads.  */
            dtp->u.p.expanded_read = 0;
 
               since a single object can have multiple reads.  */
            dtp->u.p.expanded_read = 0;
 

-           /* Now loop over the components. Update the component pointer
-              with the return value from nml_write_obj.  This loop jumps
-              past nested derived types by testing if the potential
-              component name contains '%'.  */
+           /* Now loop over the components.  */

 
            for (cmp = nl->next;
                 cmp &&
 
            for (cmp = nl->next;
                 cmp &&

-                  !strncmp (cmp->var_name, obj_name, obj_name_len) &&
-                  !strchr (cmp->var_name + obj_name_len, '%');
+                  !strncmp (cmp->var_name, obj_name, obj_name_len);

                 cmp = cmp->next)
              {
                 cmp = cmp->next)
              {

+               /* Jump over nested derived type by testing if the potential
+                  component name contains '%'.  */
+               if (strchr (cmp->var_name + obj_name_len, '%'))
+                   continue;

 
                if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
                                  pprev_nl, nml_err_msg, nml_err_msg_size,
 
                if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
                                  pprev_nl, nml_err_msg, nml_err_msg_size,


@@ -2885,7 +2885,8 @@ get_name:
          goto nml_err_ret;
        }
 
          goto nml_err_ret;
        }
 

-      if (*pprev_nl == NULL || !component_flag)
+      /* Don't move first_nl further in the list if a qualifier was found.  */
+      if ((*pprev_nl == NULL && !qualifier_flag) || !component_flag)

        first_nl = nl;
 
       root_nl = nl;
        first_nl = nl;
 
       root_nl = nl;