aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2010-09-04 19:47:02 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2010-09-04 19:47:02 +0200
commite060847174c062531afd9061761b516cb6229960 (patch)
tree85293d8ba5a38313067f3f4722a13e72d0dd28ec /gcc
parent17f39a395648213a0c6014e84ff34f3ff565a10b (diff)
downloadgcc-e060847174c062531afd9061761b516cb6229960.zip
gcc-e060847174c062531afd9061761b516cb6229960.tar.gz
gcc-e060847174c062531afd9061761b516cb6229960.tar.bz2
re PR fortran/45530 (gfortran internal compiler error)
2010-09-04 Tobias Burnus <burnus@net-b.de> PR fortran/45530 * resolve.c (resolve_fl_namelist): Change constraint checking order to prevent endless loop. 2010-09-04 Tobias Burnus <burnus@net-b.de> PR fortran/45530 * gfortran.dg/namelist_63.f90: New. From-SVN: r163862
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/resolve.c80
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/namelist_63.f9028
4 files changed, 79 insertions, 40 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 428cd3f..d9dbb73 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-09-04 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/45530
+ * resolve.c (resolve_fl_namelist): Change constraint checking
+ order to prevent endless loop.
+
2010-09-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/45507
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9099ada..b35898a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11566,6 +11566,46 @@ resolve_fl_namelist (gfc_symbol *sym)
gfc_namelist *nl;
gfc_symbol *nlsym;
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ /* Reject namelist arrays of assumed shape. */
+ if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
+ && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
+ "must not have assumed shape in namelist "
+ "'%s' at %L", nl->sym->name, sym->name,
+ &sym->declared_at) == FAILURE)
+ return FAILURE;
+
+ /* Reject namelist arrays that are not constant shape. */
+ if (is_non_constant_shape_array (nl->sym))
+ {
+ gfc_error ("NAMELIST array object '%s' must have constant "
+ "shape in namelist '%s' at %L", nl->sym->name,
+ sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* Namelist objects cannot have allocatable or pointer components. */
+ if (nl->sym->ts.type != BT_DERIVED)
+ continue;
+
+ if (nl->sym->ts.u.derived->attr.alloc_comp)
+ {
+ gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+ "have ALLOCATABLE components",
+ nl->sym->name, sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ if (nl->sym->ts.u.derived->attr.pointer_comp)
+ {
+ gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+ "have POINTER components",
+ nl->sym->name, sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
/* Reject PRIVATE objects in a PUBLIC namelist. */
if (gfc_check_access(sym->attr.access, sym->ns->default_access))
{
@@ -11607,46 +11647,6 @@ resolve_fl_namelist (gfc_symbol *sym)
}
}
- for (nl = sym->namelist; nl; nl = nl->next)
- {
- /* Reject namelist arrays of assumed shape. */
- if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
- && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
- "must not have assumed shape in namelist "
- "'%s' at %L", nl->sym->name, sym->name,
- &sym->declared_at) == FAILURE)
- return FAILURE;
-
- /* Reject namelist arrays that are not constant shape. */
- if (is_non_constant_shape_array (nl->sym))
- {
- gfc_error ("NAMELIST array object '%s' must have constant "
- "shape in namelist '%s' at %L", nl->sym->name,
- sym->name, &sym->declared_at);
- return FAILURE;
- }
-
- /* Namelist objects cannot have allocatable or pointer components. */
- if (nl->sym->ts.type != BT_DERIVED)
- continue;
-
- if (nl->sym->ts.u.derived->attr.alloc_comp)
- {
- gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
- "have ALLOCATABLE components",
- nl->sym->name, sym->name, &sym->declared_at);
- return FAILURE;
- }
-
- if (nl->sym->ts.u.derived->attr.pointer_comp)
- {
- gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
- "have POINTER components",
- nl->sym->name, sym->name, &sym->declared_at);
- return FAILURE;
- }
- }
-
/* 14.1.2 A module or internal procedure represent local entities
of the same type as a namelist member and so are not allowed. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f5306a9..f55b40e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-04 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/45530
+ * gfortran.dg/namelist_63.f90: New.
+
2010-09-04 Jan Hubicka <jh@suse.cz>
* gcc.dg/tree-ssa/foldconst-2.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/namelist_63.f90 b/gcc/testsuite/gfortran.dg/namelist_63.f90
new file mode 100644
index 0000000..1d02789
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_63.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/45530
+!
+! Contributed by david.sagan@gmail.com
+!
+program test
+implicit none
+
+type c_struct
+ type (g_struct), pointer :: g
+end type
+
+type g_struct
+ type (p_struct), pointer :: p
+end type
+
+type p_struct
+ type (region_struct), pointer :: r
+end type
+
+type region_struct
+ type (p_struct) plot
+end type
+
+type (c_struct) curve(10)
+namelist / params / curve ! { dg-error "NAMELIST object .curve. in namelist .params. at .1. cannot have POINTER components" }
+end program