diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 31f1f826008b9b889c01430c5229d86f442019cb..fa5bb4f1d2782424b9f86f90d06d6ac2673bb0f4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-12-22 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + 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 <pault@gcc.gnu.org> PR fortran/20889 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c1451e38cb010e4934ad88756f1eab9178da18d2..c55b142d0382a4ce43d741ab1ed0769a7dbc0c99 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 475b0ca5461d355e043e6532f0c157ba8462b16a..e160e00d09f234a0d5d987e61b254a8f70e422b4 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 5ba4c8e66e832d4e4a0107e7472c6d8e268c0620..5f5ce5694e352064589993b5a96ab4f6455e752a 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 d7eb3eb61facc5a42228847e4f3c05e86a253208..4734f8150bdeaff676e709283b6dd5225a3d7e1c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-12-22 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/18990 + * gfortran.dg/der_charlen_1.f90: New. + 2005-12-22 Paul Thomas <pault@gcc.gnu.org> 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 0000000000000000000000000000000000000000..9f394c73f25a3e263e0107bb6403818e6e09bfbc --- /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