This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch,Fortran] PR41582 allocate patch for CLASS
- From: Tobias Burnus <burnus at net-b dot de>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 9 Oct 2009 19:11:52 +0200
- Subject: [Patch,Fortran] PR41582 allocate patch for CLASS
Hello,
this patch implements
a) A constraint for ALLOCATE (class with abstract base type):
"C625 (R623) If any allocate-object is unlimited polymorphic or
is of abstract type, either type-spec or SOURCE= shall appear."
(If you miss "abstract type" in your copy of the standard, you
do not have read Corrigendum 1.)
b) Reject "allocate(..., SOURCE=<class>)". To make it work, one
needs to know the size at run time, which does not work yet. I
think it makes sense to reject it rather than to use the size of
the base type and only to warn about it.
(This is probably the most important missing feature in gfortran's
OOP implementation.)
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
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.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 152593)
+++ gcc/fortran/decl.c (working copy)
@@ -1077,6 +1077,7 @@ encapsulate_class_symbol (gfc_typespec *
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;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 152593)
+++ gcc/fortran/resolve.c (working copy)
@@ -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_
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_
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_
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_
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",
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 152593)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -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));
}
Index: gcc/testsuite/gfortran.dg/class_allocate_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_1.f03 (revision 152593)
+++ gcc/testsuite/gfortran.dg/class_allocate_1.f03 (working copy)
@@ -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=<class>
+! allocate(cp, source = cp2)
+ allocate(t2 :: cp3)
+ allocate(cp, source=cp3)
select type (cp)
type is (t1)
i = 1
Index: gcc/testsuite/gfortran.dg/class_allocate_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_2.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/class_allocate_2.f03 (revision 0)
@@ -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