diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 16 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 16 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 16 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_22.f03 | 31 |
6 files changed, 73 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9e4702e..abba8f5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,14 @@ 2010-05-22 Janus Weil <janus@gcc.gnu.org> + PR fortran/44212 + * match.c (gfc_match_select_type): On error jump back out of the local + namespace. + * parse.c (parse_derived): Defer creation of vtab symbols to resolution + stage, more precisely to ... + * resolve.c (resolve_fl_derived): ... this place. + +2010-05-22 Janus Weil <janus@gcc.gnu.org> + PR fortran/44213 * resolve.c (ensure_not_abstract): Allow abstract types with non-abstract ancestors. diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 0f970f6..a2ecb3a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -4319,7 +4319,10 @@ gfc_match_select_type (void) expr1 = gfc_get_expr(); expr1->expr_type = EXPR_VARIABLE; if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false)) - return MATCH_ERROR; + { + m = MATCH_ERROR; + goto cleanup; + } if (expr2->ts.type == BT_UNKNOWN) expr1->symtree->n.sym->attr.untyped = 1; else @@ -4331,19 +4334,20 @@ gfc_match_select_type (void) { m = gfc_match (" %e ", &expr1); if (m != MATCH_YES) - return m; + goto cleanup; } m = gfc_match (" )%t"); if (m != MATCH_YES) - return m; + goto cleanup; /* Check for F03:C811. */ if (!expr2 && (expr1->expr_type != EXPR_VARIABLE || expr1->ref != NULL)) { gfc_error ("Selector in SELECT TYPE at %C is not a named variable; " "use associate-name=>"); - return MATCH_ERROR; + m = MATCH_ERROR; + goto cleanup; } new_st.op = EXEC_SELECT_TYPE; @@ -4354,6 +4358,10 @@ gfc_match_select_type (void) select_type_push (expr1->symtree->n.sym); return MATCH_YES; + +cleanup: + gfc_current_ns = gfc_current_ns->parent; + return m; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 9320069..dfc5893 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2110,22 +2110,6 @@ endType: || c->attr.access == ACCESS_PRIVATE || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp)) sym->attr.private_comp = 1; - - /* Fix up incomplete CLASS components. */ - if (c->ts.type == BT_CLASS) - { - gfc_component *data; - gfc_component *vptr; - gfc_symbol *vtab; - data = gfc_find_component (c->ts.u.derived, "$data", true, true); - vptr = gfc_find_component (c->ts.u.derived, "$vptr", true, true); - if (vptr->ts.u.derived == NULL) - { - vtab = gfc_find_derived_vtab (data->ts.u.derived, false); - gcc_assert (vtab); - vptr->ts.u.derived = vtab->ts.u.derived; - } - } } if (!seen_component) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f08e198..1f4c236 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10577,6 +10577,22 @@ resolve_fl_derived (gfc_symbol *sym) int i; super_type = gfc_get_derived_super_type (sym); + + if (sym->attr.is_class && sym->ts.u.derived == NULL) + { + /* Fix up incomplete CLASS symbols. */ + gfc_component *data; + gfc_component *vptr; + gfc_symbol *vtab; + data = gfc_find_component (sym, "$data", true, true); + vptr = gfc_find_component (sym, "$vptr", true, true); + if (vptr->ts.u.derived == NULL) + { + vtab = gfc_find_derived_vtab (data->ts.u.derived, false); + gcc_assert (vtab); + vptr->ts.u.derived = vtab->ts.u.derived; + } + } /* F2008, C432. */ if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 70f6272..6c31ffb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-05-22 Janus Weil <janus@gcc.gnu.org> + + PR fortran/44212 + * gfortran.dg/class_22.f03: New. + 2010-05-22 Iain Sandoe <iains@gcc.gnu.org> PR lto/44238 diff --git a/gcc/testsuite/gfortran.dg/class_22.f03 b/gcc/testsuite/gfortran.dg/class_22.f03 new file mode 100644 index 0000000..df68783 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_22.f03 @@ -0,0 +1,31 @@ +! { dg-do compile } +! +! PR 44212: [OOP] ICE when defining a pointer component before defining the class and calling a TBP then +! +! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de> + +module ice_module + + type :: B_type + class(A_type),pointer :: A_comp + end type B_type + + type :: A_type + contains + procedure :: A_proc + end type A_type + +contains + + subroutine A_proc(this) + class(A_type),target,intent(inout) :: this + end subroutine A_proc + + subroutine ice_proc(this) + class(A_type) :: this + call this%A_proc() + end subroutine ice_proc + +end module ice_module + +! { dg-final { cleanup-modules "ice_module" } } |