From: Tobias Burnus Date: Sat, 4 Sep 2010 17:47:02 +0000 (+0200) Subject: re PR fortran/45530 (gfortran internal compiler error) X-Git-Tag: releases/gcc-4.6.0~4647 X-Git-Url: https://gcc.gnu.org/git/?a=commitdiff_plain;h=e060847174c062531afd9061761b516cb6229960;p=gcc.git re PR fortran/45530 (gfortran internal compiler error) 2010-09-04 Tobias Burnus PR fortran/45530 * resolve.c (resolve_fl_namelist): Change constraint checking order to prevent endless loop. 2010-09-04 Tobias Burnus PR fortran/45530 * gfortran.dg/namelist_63.f90: New. From-SVN: r163862 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 428cd3f25cf6..d9dbb737369d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-09-04 Tobias Burnus + + PR fortran/45530 + * resolve.c (resolve_fl_namelist): Change constraint checking + order to prevent endless loop. + 2010-09-04 Janus Weil PR fortran/45507 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9099ada8f518..b35898add053 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 f5306a92ac2b..f55b40e2d310 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-09-04 Tobias Burnus + + PR fortran/45530 + * gfortran.dg/namelist_63.f90: New. + 2010-09-04 Jan Hubicka * 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 000000000000..1d02789fa547 --- /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