From d0a9804e353b33d339e20f0aa2bd458a4ff08649 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 9 Oct 2009 22:34:35 +0200 Subject: re PR fortran/41582 ([OOP] Allocation of abstract types requires a type spec or a SOURCE) 2009-10-09 Tobias Burnus PR fortran/41582 * decl.c (encapsulate_class_symbol): Save attr.abstract. * resolve.c (resolve_allocate_expr): Reject class allocate without typespec or source=. * trans-stmt.c (gfc_trans_allocate): Change gfc_warning into gfc_error for "not yet implemented". 2009-10-09 Tobias Burnus PR fortran/41582 * gfortran.dg/class_allocate_1.f03: Modify code such that it compiles with the gfc_warning->gfc_error change. * gfortran.dg/class_allocate_1.f03: New test. From-SVN: r152601 --- gcc/fortran/resolve.c | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1aee540..5ea41c9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5840,7 +5840,7 @@ gfc_expr_to_initialize (gfc_expr *e) static gfc_try resolve_allocate_expr (gfc_expr *e, gfc_code *code) { - int i, pointer, allocatable, dimension, check_intent_in; + int i, pointer, allocatable, dimension, check_intent_in, is_abstract; symbol_attribute attr; gfc_ref *ref, *ref2; gfc_array_ref *ar; @@ -5862,6 +5862,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) if (e->symtree) sym = e->symtree->n.sym; + /* Check whether ultimate component is abstract and CLASS. */ + is_abstract = 0; + if (e->expr_type != EXPR_VARIABLE) { allocatable = 0; @@ -5876,6 +5879,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) allocatable = sym->ts.u.derived->components->attr.allocatable; pointer = sym->ts.u.derived->components->attr.pointer; dimension = sym->ts.u.derived->components->attr.dimension; + is_abstract = sym->ts.u.derived->components->attr.abstract; } else { @@ -5903,12 +5907,14 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) allocatable = c->ts.u.derived->components->attr.allocatable; pointer = c->ts.u.derived->components->attr.pointer; dimension = c->ts.u.derived->components->attr.dimension; + is_abstract = c->ts.u.derived->components->attr.abstract; } else { allocatable = c->attr.allocatable; pointer = c->attr.pointer; dimension = c->attr.dimension; + is_abstract = c->attr.abstract; } break; @@ -5927,6 +5933,14 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) return FAILURE; } + if (is_abstract && !code->expr3 && code->ext.alloc.ts.type == BT_UNKNOWN) + { + gcc_assert (e->ts.type == BT_CLASS); + gfc_error ("Allocating %s of ABSTRACT base type at %L requires a " + "type-spec or SOURCE=", sym->name, &e->where); + return FAILURE; + } + if (check_intent_in && sym->attr.intent == INTENT_IN) { gfc_error ("Cannot allocate INTENT(IN) variable '%s' at %L", -- cgit v1.1