diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-05-29 15:15:16 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-05-29 15:15:16 +0200 |
| commit | 16023efc1e94fcedcd76bef886c266a30976dbde (patch) | |
| tree | d9668ce9a676b9aa3ca7f365ef44fccebd997edc /gcc/fortran/class.c | |
| parent | a5350ddc612732cc2a3cb313ed86d4c6dbf7907a (diff) | |
| download | gcc-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.c | 18 |
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; |