From 86035eeca65c54f7325fb6edd5839e3b59ad5002 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 3 Dec 2012 22:13:42 +0100 Subject: [PATCH] re PR fortran/37336 ([F03] Finish derived-type finalization) 2012-12-03 Tobias Burnus Janus Weil PR fortran/37336 * class.c (gfc_is_finalizable): New function. * gfortran.h (gfc_is_finalizable): Its prototype. * module.c (mio_component): Read initializer for vtype's _final. * resolve.c (resolve_fl_derived0): Call gfc_is_finalizable. * trans-expr.c (gfc_vtable_final_get): New function. (conv_parent_component_references): Fix comment. (gfc_conv_variable): Fix for scalar coarray components. * trans-intrinsic.c (conv_intrinsic_move_alloc): For BT_CLASS, pass the BT_CLASS type and not the declared type to gfc_deallocate_scalar_with_status. * trans.h (gfc_vtable_final_get): New prototype. Co-Authored-By: Janus Weil From-SVN: r194104 --- gcc/fortran/ChangeLog | 16 +++++++++++++ gcc/fortran/class.c | 42 +++++++++++++++++++++++++++++++++++ gcc/fortran/gfortran.h | 2 ++ gcc/fortran/module.c | 2 +- gcc/fortran/resolve.c | 4 ++++ gcc/fortran/trans-expr.c | 14 +++++++++++- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans.h | 1 + 8 files changed, 80 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 30f82fd5ef8..f6b4fb05c94 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2012-12-03 Tobias Burnus + Janus Weil + + PR fortran/37336 + * class.c (gfc_is_finalizable): New function. + * gfortran.h (gfc_is_finalizable): Its prototype. + * module.c (mio_component): Read initializer for vtype's _final. + * resolve.c (resolve_fl_derived0): Call gfc_is_finalizable. + * trans-expr.c (gfc_vtable_final_get): New function. + (conv_parent_component_references): Fix comment. + (gfc_conv_variable): Fix for scalar coarray components. + * trans-intrinsic.c (conv_intrinsic_move_alloc): For BT_CLASS, + pass the BT_CLASS type and not the declared type to + gfc_deallocate_scalar_with_status. + * trans.h (gfc_vtable_final_get): New prototype. + 2012-12-03 Tobias Burnus PR fortran/55475 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 1271300900b..8a8a54aa9ba 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2013,6 +2013,48 @@ cleanup: } +/* Check if a derived type is finalizable. That is the case if it + (1) has a FINAL subroutine or + (2) has a nonpointer nonallocatable component of finalizable type. + If it is finalizable, return an expression containing the + finalization wrapper. */ + +bool +gfc_is_finalizable (gfc_symbol *derived, gfc_expr **final_expr) +{ + gfc_symbol *vtab; + gfc_component *c; + + /* (1) Check for FINAL subroutines. */ + if (derived->f2k_derived && derived->f2k_derived->finalizers) + goto yes; + + /* (2) Check for components of finalizable type. */ + for (c = derived->components; c; c = c->next) + if (c->ts.type == BT_DERIVED + && !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable + && gfc_is_finalizable (c->ts.u.derived, NULL)) + goto yes; + + return false; + +yes: + /* Make sure vtab is generated. */ + vtab = gfc_find_derived_vtab (derived); + if (final_expr) + { + /* Return finalizer expression. */ + gfc_component *final; + final = vtab->ts.u.derived->components->next->next->next->next->next; + gcc_assert (strcmp (final->name, "_final") == 0); + gcc_assert (final->initializer + && final->initializer->expr_type != EXPR_NULL); + *final_expr = final->initializer; + } + return true; +} + + /* General worker function to find either a type-bound procedure or a type-bound user operator. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4942c1c920e..bf767b2ac97 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2951,6 +2951,7 @@ void gfc_add_class_array_ref (gfc_expr *); #define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash") #define gfc_add_size_component(e) gfc_add_component_ref(e,"_size") #define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init") +#define gfc_add_final_component(e) gfc_add_component_ref(e,"_final") bool gfc_is_class_array_ref (gfc_expr *, bool *); bool gfc_is_class_scalar_expr (gfc_expr *); bool gfc_is_class_container_ref (gfc_expr *e); @@ -2967,6 +2968,7 @@ gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*, gfc_intrinsic_op, bool, locus*); gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*); +bool gfc_is_finalizable (gfc_symbol *, gfc_expr **); #define CLASS_DATA(sym) sym->ts.u.derived->components diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 89c45b7c047..16ea97b72cd 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2597,7 +2597,7 @@ mio_component (gfc_component *c, int vtype) c->attr.class_ok = 1; c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); - if (!vtype) + if (!vtype || strcmp (c->name, "_final") == 0) mio_expr (&c->initializer); if (c->attr.proc_pointer) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7d434ddc319..69646dee748 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12814,6 +12814,10 @@ resolve_fl_derived0 (gfc_symbol *sym) /* Add derived type to the derived type list. */ add_dt_to_dt_list (sym); + /* Check if the type is finalizable. This is done in order to ensure that the + finalization wrapper is generated early enough. */ + gfc_is_finalizable (sym, NULL); + return SUCCESS; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d6410d3ac49..42f6e0cdea5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -95,6 +95,7 @@ conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) #define VTABLE_EXTENDS_FIELD 2 #define VTABLE_DEF_INIT_FIELD 3 #define VTABLE_COPY_FIELD 4 +#define VTABLE_FINAL_FIELD 5 tree @@ -180,6 +181,13 @@ gfc_vtable_copy_get (tree decl) } +tree +gfc_vtable_final_get (tree decl) +{ + return gfc_vtable_field_get (decl, VTABLE_FINAL_FIELD); +} + + #undef CLASS_DATA_FIELD #undef CLASS_VPTR_FIELD #undef VTABLE_HASH_FIELD @@ -187,6 +195,7 @@ gfc_vtable_copy_get (tree decl) #undef VTABLE_EXTENDS_FIELD #undef VTABLE_DEF_INIT_FIELD #undef VTABLE_COPY_FIELD +#undef VTABLE_FINAL_FIELD /* Obtain the vptr of the last class reference in an expression. */ @@ -1510,7 +1519,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref) dt = ref->u.c.sym; c = ref->u.c.component; - /* Return if the component is not in the parent type. */ + /* Return if the component is in the parent type. */ for (cmp = dt->components; cmp; cmp = cmp->next) if (strcmp (c->name, cmp->name) == 0) return; @@ -1714,6 +1723,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) conv_parent_component_references (se, ref); gfc_conv_component_ref (se, ref); + if (!ref->next && ref->u.c.sym->attr.codimension + && se->want_pointer && se->descriptor_only) + return; break; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e9eb307262f..504a9f3b8fc 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7321,7 +7321,7 @@ conv_intrinsic_move_alloc (gfc_code *code) /* Deallocate "to". */ tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, true, - to_expr2, to_expr->ts); + to_expr, to_expr->ts); gfc_add_expr_to_block (&block, tmp); /* Assign (_data) pointers. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 954dcd3400f..17795750573 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -348,6 +348,7 @@ tree gfc_vtable_size_get (tree); tree gfc_vtable_extends_get (tree); tree gfc_vtable_def_init_get (tree); tree gfc_vtable_copy_get (tree); +tree gfc_vtable_final_get (tree); tree gfc_get_vptr_from_expr (tree); tree gfc_get_class_array_ref (tree, tree); tree gfc_copy_class_to_class (tree, tree, tree); -- 2.30.2