summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2013-03-20 07:56:02 +0000
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2013-03-20 07:56:02 +0000
commita2d1e432980e807d06d9540548634773cc2d5629 (patch)
tree07020549d3f618a7a7b389436c1d33789630a6d6
parent093f923b005865916b8f8933a3a9fbb7ff341e1a (diff)
downloadgcc-a2d1e432980e807d06d9540548634773cc2d5629.tar.gz
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-03-20 Tilo Schwarz <tilo@tilo-schwarz.de> PR libfortran/51825 * gcc/testsuite/gfortran.dg/namelist_77.f90: New. * gcc/testsuite/gfortran.dg/namelist_78.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@196806 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/namelist_77.f9049
-rw-r--r--gcc/testsuite/gfortran.dg/namelist_78.f9034
-rw-r--r--libgfortran/ChangeLog8
-rw-r--r--libgfortran/io/list_read.c15
5 files changed, 105 insertions, 7 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7fe42de5bf2..72f436e78ae 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,11 @@
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
+ PR libfortran/51825
+ * gfortran.dg/namelist_77.f90: New.
+ * gfortran.dg/namelist_78.f90: New.
+
+2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
+
PR libfortran/48618
* gfortran.dg/open_negative_unit_1.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/namelist_77.f90 b/gcc/testsuite/gfortran.dg/namelist_77.f90
new file mode 100644
index 00000000000..5cbfe3aad65
--- /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
index 00000000000..d4e29ab8228
--- /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 31d5b57ef91..877d2d0c959 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,5 +1,13 @@
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-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
+
PR libfortran/48618
* io/open.c (st_open): Raise error for unit number < 0 only if
unit number does not exist already.
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 22125be1afe..aa7c8c0d2c1 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2578,17 +2578,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;
- /* 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 &&
- !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)
{
+ /* 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,
@@ -2901,7 +2901,8 @@ get_name:
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;