diff options
author | Tobias Burnus <burnus@net-b.de> | 2010-09-04 19:47:02 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-09-04 19:47:02 +0200 |
commit | e060847174c062531afd9061761b516cb6229960 (patch) | |
tree | 85293d8ba5a38313067f3f4722a13e72d0dd28ec /gcc | |
parent | 17f39a395648213a0c6014e84ff34f3ff565a10b (diff) | |
download | gcc-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/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 80 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/namelist_63.f90 | 28 |
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 |