aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/class.c
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2013-05-29 15:15:16 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2013-05-29 15:15:16 +0200
commit16023efc1e94fcedcd76bef886c266a30976dbde (patch)
treed9668ce9a676b9aa3ca7f365ef44fccebd997edc /gcc/fortran/class.c
parenta5350ddc612732cc2a3cb313ed86d4c6dbf7907a (diff)
downloadgcc-16023efc1e94fcedcd76bef886c266a30976dbde.zip
gcc-16023efc1e94fcedcd76bef886c266a30976dbde.tar.gz
gcc-16023efc1e94fcedcd76bef886c266a30976dbde.tar.bz2
re PR fortran/37336 ([F03] Finish derived-type finalization)
2013-05-28 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * class.c (finalize_component): Fix coarray array refs. (generate_finalization_wrapper): Only gfc_convert_type_warn when the kind value is different. (gfc_find_intrinsic_vtab): _copy's dst is now intent(inout). (gfc_find_derived_vtab): Ditto. Enable finalization-wrapper generation. * module.c (MOD_VERSION): Bump. (gfc_dump_module, gfc_use_module): Remove empty line in .mod. * trans-array.c (gfc_conv_descriptor_token): Accept * nonrestricted void pointer. (gfc_array_allocate, structure_alloc_comps): Don't nullify for BT_CLASS allocations. * trans-stmt.c (gfc_trans_allocate): Ditto. 2013-05-28 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * gfortran.dg/auto_dealloc_2.f90: Update _free count in the * dump. * gfortran.dg/class_19.f03: Ditto. From-SVN: r199409
Diffstat (limited to 'gcc/fortran/class.c')
-rw-r--r--gcc/fortran/class.c18
1 files changed, 8 insertions, 10 deletions
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 349f494..ba8efa9 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -832,17 +832,18 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
ref->u.c.component = comp;
e->ts = comp->ts;
- if (comp->attr.dimension
+ if (comp->attr.dimension || comp->attr.codimension
|| (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
- && CLASS_DATA (comp)->attr.dimension))
+ && (CLASS_DATA (comp)->attr.dimension
+ || CLASS_DATA (comp)->attr.codimension)))
{
ref->next = gfc_get_ref ();
ref->next->type = REF_ARRAY;
- ref->next->u.ar.type = AR_FULL;
ref->next->u.ar.dimen = 0;
ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as
: comp->as;
e->rank = ref->next->u.ar.as->rank;
+ ref->next->u.ar.type = e->rank ? AR_FULL : AR_ELEMENT;
}
/* Call DEALLOCATE (comp, stat=ignore). */
@@ -1640,7 +1641,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
rank = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_RANK, "rank",
gfc_current_locus, 1,
gfc_lval_expr_from_sym (array));
- gfc_convert_type (rank, &idx->ts, 2);
+ if (rank->ts.kind != idx->ts.kind)
+ gfc_convert_type_warn (rank, &idx->ts, 2, 0);
/* Create is_contiguous variable. */
gfc_get_symbol ("is_contiguous", sub_ns, &is_contiguous);
@@ -2363,7 +2365,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
dst->attr.artificial = 1;
- dst->attr.intent = INTENT_OUT;
+ dst->attr.intent = INTENT_INOUT;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst;
@@ -2382,9 +2384,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
components and the calls to finalization subroutines.
Note: The actual wrapper function can only be generated
at resolution time. */
- /* FIXME: Enable ABI-breaking "_final" generation. */
- if (0)
- {
if (!gfc_add_component (vtype, "_final", &c))
goto cleanup;
c->attr.proc_pointer = 1;
@@ -2392,7 +2391,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
generate_finalization_wrapper (derived, ns, tname, c);
- }
/* Add procedure pointers for type-bound procedures. */
if (!derived->attr.unlimited_polymorphic)
@@ -2651,7 +2649,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
dst->ts.kind = ts->kind;
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
- dst->attr.intent = INTENT_OUT;
+ dst->attr.intent = INTENT_INOUT;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst;