From: tobi Date: Thu, 22 Dec 2005 11:37:03 +0000 (+0000) Subject: fortran/ X-Git-Tag: upstream/4.9.2~56849 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ac42ecbd18cab1fdfb50ad161d437f2edf14f2b0;p=platform%2Fupstream%2Flinaro-gcc.git 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108946 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 31f1f82..fa5bb4f 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 c1451e3..c55b142 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 475b0ca..e160e00 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 5ba4c8e..5f5ce56 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 d7eb3eb..4734f81 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 0000000..9f394c7 --- /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