mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-24 08:50:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/41582 ([OOP] Allocation of abstract types requires a type spec or a SOURCE)

Browse 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
This commit is contained in:
Tobias Burnus 2009-10-09 22:34:35 +02:00
parent 7431bf06bc
commit d0a9804e35
7 changed files with 66 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
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 Janus Weil <janus@gcc.gnu.org>
PR fortran/41579
@ -49,8 +58,8 @@
2009-10-07 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
@ -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 <matz@suse.de>

1
gcc/fortran/decl.c
View File

@ -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;

16
gcc/fortran/resolve.c
View File

@ -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",

4
gcc/fortran/trans-stmt.c
View File

@ -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));
}

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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.
2009-10-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/41579
@ -448,7 +455,7 @@
2009-10-02 Jack Howarth <howarth@bromo.med.uc.edu>
* gcc.dg/guality/guality.exp: Disable on darwin.
* gcc.dg/guality/guality.exp: Disable on darwin.
2009-10-02 Janis Johnson <janis187@us.ibm.com>
@ -5543,7 +5550,7 @@
2009-05-12 David Billinghurst <billingd@gcc.gnu.org>
* 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 <hongjiu.lu@intel.com>

6
gcc/testsuite/gfortran.dg/class_allocate_1.f03
View File

@ -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

23
gcc/testsuite/gfortran.dg/class_allocate_2.f03 Normal file
View File

@ -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