diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2009-10-09 22:34:35 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2009-10-09 22:34:35 +0200 |
| commit | d0a9804e353b33d339e20f0aa2bd458a4ff08649 (patch) | |
| tree | 7eeb58c662060f0443817dc0734fd9cc29a924a0 /gcc/fortran/resolve.c | |
| parent | 7431bf06bc2bb01a307a796bf4de57d9ca48bb38 (diff) | |
| download | gcc-d0a9804e353b33d339e20f0aa2bd458a4ff08649.zip gcc-d0a9804e353b33d339e20f0aa2bd458a4ff08649.tar.gz gcc-d0a9804e353b33d339e20f0aa2bd458a4ff08649.tar.bz2 | |
re PR fortran/41582 ([OOP] Allocation of abstract types requires a type spec or a SOURCE)
2009-10-09 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
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
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 16 |
1 files changed, 15 insertions, 1 deletions
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", |