From: Tobias Schlüter Date: Thu, 22 Dec 2005 11:37:03 +0000 (+0100) Subject: re PR fortran/18990 (ICE in gfc_get_derived_type, at fortran/trans-types.c) X-Git-Tag: releases/gcc-4.2.0~5189 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=110eec241d7bc08f91573738b449bafbb52e3498;p=thirdparty%2Fgcc.git re PR fortran/18990 (ICE in gfc_get_derived_type, at fortran/trans-types.c) fortran/ PR fortran/18990 * gfortran.h (gfc_charlen): Add resolved field. * expr.c (gfc_specification_expr): Accept NULL argument. * resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New. (gfc_resolve_symbol): Resolve derived type definitions. Use resolve_charlen to resolve character lengths. testsuite/ PR fortran/18990 * gfortran.dg/der_charlen_1.f90: New. From-SVN: r108946 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 31f1f826008b..fa5bb4f1d278 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-12-22 Tobias Schl"uter + + PR fortran/18990 + * gfortran.h (gfc_charlen): Add resolved field. + * expr.c (gfc_specification_expr): Accept NULL argument. + * resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New. + (gfc_resolve_symbol): Resolve derived type definitions. Use + resolve_charlen to resolve character lengths. + 2005-12-22 Paul Thomas PR fortran/20889 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c1451e38cb01..c55b142d0382 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1768,6 +1768,8 @@ check_restricted (gfc_expr * e) try gfc_specification_expr (gfc_expr * e) { + if (e == NULL) + return SUCCESS; if (e->ts.type != BT_INTEGER) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 475b0ca5461d..e160e00d09f2 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -571,6 +571,8 @@ typedef struct gfc_charlen struct gfc_expr *length; struct gfc_charlen *next; tree backend_decl; + + int resolved; } gfc_charlen; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5ba4c8e66e83..5f5ce5694e35 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4328,6 +4328,60 @@ resolve_values (gfc_symbol * sym) } +/* Resolve a charlen structure. */ + +static try +resolve_charlen (gfc_charlen *cl) +{ + if (cl->resolved) + return SUCCESS; + + cl->resolved = 1; + + if (gfc_resolve_expr (cl->length) == FAILURE) + return FAILURE; + + if (gfc_simplify_expr (cl->length, 0) == FAILURE) + return FAILURE; + + if (gfc_specification_expr (cl->length) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +/* Resolve the components of a derived type. */ + +static try +resolve_derived (gfc_symbol *sym) +{ + gfc_component *c; + + for (c = sym->components; c != NULL; c = c->next) + { + if (c->ts.type == BT_CHARACTER) + { + if (resolve_charlen (c->ts.cl) == FAILURE) + return FAILURE; + + if (c->ts.cl->length == NULL + || !gfc_is_constant_expr (c->ts.cl->length)) + { + gfc_error ("Character length of component '%s' needs to " + "be a constant specification expression at %L.", + c->name, + c->ts.cl->length ? &c->ts.cl->length->where : &c->loc); + return FAILURE; + } + } + + /* TODO: Anything else that should be done here? */ + } + + return SUCCESS; +} + /* Do anything necessary to resolve a symbol. Right now, we just assume that an otherwise unknown symbol is a variable. This sort of thing commonly happens for symbols in module. */ @@ -4380,6 +4434,9 @@ resolve_symbol (gfc_symbol * sym) } } + if (sym->attr.flavor == FL_DERIVED && resolve_derived (sym) == FAILURE) + return; + /* Symbols that are module procedures with results (functions) have the types and array specification copied for type checking in procedures that call them, as well as for saving to a module @@ -5588,16 +5645,7 @@ gfc_resolve (gfc_namespace * ns) gfc_check_interfaces (ns); for (cl = ns->cl_list; cl; cl = cl->next) - { - if (cl->length == NULL || gfc_resolve_expr (cl->length) == FAILURE) - continue; - - if (gfc_simplify_expr (cl->length, 0) == FAILURE) - continue; - - if (gfc_specification_expr (cl->length) == FAILURE) - continue; - } + resolve_charlen (cl); gfc_traverse_ns (ns, resolve_values); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d7eb3eb61fac..4734f8150bde 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-12-22 Tobias Schl"uter + + PR fortran/18990 + * gfortran.dg/der_charlen_1.f90: New. + 2005-12-22 Paul Thomas PR fortran/20889 diff --git a/gcc/testsuite/gfortran.dg/der_charlen_1.f90 b/gcc/testsuite/gfortran.dg/der_charlen_1.f90 new file mode 100644 index 000000000000..9f394c73f25a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/der_charlen_1.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! PR 18990 +! we used to ICE on these examples +module core + type, public :: T + character(len=I) :: str ! { dg-error "needs to be a constant specification expression" } + end type T + private +CONTAINS + subroutine FOO(X) + type(T), intent(in) :: X + end subroutine +end module core + +module another_core + type :: T + character(len=*) :: s ! { dg-error "needs to be a constant specification expr" } + end type T + private +CONTAINS + subroutine FOO(X) + type(T), intent(in) :: X + end subroutine +end module another_core