From d0a9804e353b33d339e20f0aa2bd458a4ff08649 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 9 Oct 2009 22:34:35 +0200 Subject: [PATCH] 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/ChangeLog | 14 ++++++++--- gcc/fortran/decl.c | 1 + gcc/fortran/resolve.c | 16 ++++++++++++- gcc/fortran/trans-stmt.c | 4 ++-- gcc/testsuite/ChangeLog | 11 +++++++-- .../gfortran.dg/class_allocate_1.f03 | 6 ++++- .../gfortran.dg/class_allocate_2.f03 | 23 +++++++++++++++++++ 7 files changed, 66 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_allocate_2.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c54639a15b54..899673d7dc6c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +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 Janus Weil PR fortran/41579 @@ -49,8 +58,8 @@ 2009-10-07 Paul Thomas - PR fortran/41613 - * resolve.c (check_class_members): Reset compcall.assign. + PR fortran/41613 + * resolve.c (check_class_members): Reset compcall.assign. 2009-10-05 Paul Thomas @@ -373,7 +382,6 @@ * parse.c (next_free): Improve error locus printing. (next_fixed): Change gfc_warn to gfc_warning_now, and improve locus reporting. - 2009-09-16 Michael Matz diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 82442042dcc5..2c378fb43e40 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1077,6 +1077,7 @@ encapsulate_class_symbol (gfc_typespec *ts, symbol_attribute *attr, c->attr.pointer = attr->pointer || attr->dummy; c->attr.allocatable = attr->allocatable; c->attr.dimension = attr->dimension; + c->attr.abstract = ts->u.derived->attr.abstract; c->as = (*as); c->initializer = gfc_get_expr (); c->initializer->expr_type = EXPR_NULL; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1aee540969c9..5ea41c9bdf8f 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", diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 05ed23e4c05f..110534d2a5eb 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4025,8 +4025,8 @@ gfc_trans_allocate (gfc_code * code) gfc_typespec *ts; /* TODO: Size must be determined at run time, since it must equal the size of the dynamic type of SOURCE, not the declared type. */ - gfc_warning ("Dynamic size allocation at %L not supported yet, " - "using size of declared type", &code->loc); + gfc_error ("Using SOURCE= with a class variable at %L not " + "supported yet", &code->loc); ts = &code->expr3->ts.u.derived->components->ts; tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts)); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 537f11fb1408..ce6dcc2a8e76 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +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. + 2009-10-09 Janus Weil PR fortran/41579 @@ -448,7 +455,7 @@ 2009-10-02 Jack Howarth - * gcc.dg/guality/guality.exp: Disable on darwin. + * gcc.dg/guality/guality.exp: Disable on darwin. 2009-10-02 Janis Johnson @@ -5543,7 +5550,7 @@ 2009-05-12 David Billinghurst * lib/target-supports.exp (check_profiling_available): Return - false for -p on *-*-cygwin* targets. + false for -p on *-*-cygwin* targets. 2009-05-11 H.J. Lu diff --git a/gcc/testsuite/gfortran.dg/class_allocate_1.f03 b/gcc/testsuite/gfortran.dg/class_allocate_1.f03 index 844e1447fbf4..719d90cf8f9b 100644 --- a/gcc/testsuite/gfortran.dg/class_allocate_1.f03 +++ b/gcc/testsuite/gfortran.dg/class_allocate_1.f03 @@ -20,6 +20,7 @@ end type class(t1),pointer :: cp, cp2 + type(t2),pointer :: cp3 type(t3) :: x integer :: i @@ -67,7 +68,10 @@ i = 0 allocate(t2 :: cp2) - allocate(cp, source = cp2) ! { dg-warning "not supported yet" } +! FIXME: Not yet supported: source= +! allocate(cp, source = cp2) + allocate(t2 :: cp3) + allocate(cp, source=cp3) select type (cp) type is (t1) i = 1 diff --git a/gcc/testsuite/gfortran.dg/class_allocate_2.f03 b/gcc/testsuite/gfortran.dg/class_allocate_2.f03 new file mode 100644 index 000000000000..d6a5d78bd758 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_2.f03 @@ -0,0 +1,23 @@ +! { dg-do compile } +! +! PR fortran/41582 +! +subroutine test() +type :: t +end type t +class(t), allocatable :: c,d +allocate(t :: d) +allocate(c,source=d) ! { dg-error "not supported yet" } +end + +type, abstract :: t +end type t +type t2 + class(t), pointer :: t +end type t2 + +class(t), allocatable :: a,c,d +type(t2) :: b +allocate(a) ! { dg-error "requires a type-spec or SOURCE" } +allocate(b%t) ! { dg-error "requires a type-spec or SOURCE" } +end