diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2015-10-25 21:31:12 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2015-10-25 21:31:12 +0000 |
commit | 6a4236ceb1020bcb8af45f2497672435d75c2c84 (patch) | |
tree | dad621aa8de0b50bc5d3198c9849d312a7e7ddca /gcc/fortran/trans-array.c | |
parent | 9621d52481aef48baf90fb0008b4e2ff403bc90b (diff) |
re PR fortran/67171 (sourced allocation)
2015-01-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/67171
* trans-array.c (structure_alloc_comps): On deallocation of
class components, reset the vptr to the declared type vtable
and reset the _len field of unlimited polymorphic components.
*trans-expr.c (gfc_find_and_cut_at_last_class_ref): Bail out on
allocatable component references to the right of part reference
with non-zero rank and return NULL.
(gfc_reset_vptr): Simplify this function by using the function
gfc_get_vptr_from_expr. Return if the vptr is NULL_TREE.
(gfc_reset_len): If gfc_find_and_cut_at_last_class_ref returns
NULL return.
* trans-stmt.c (gfc_trans_allocate): Rely on the use of
gfc_trans_assignment if expr3 is a variable expression since
this deals correctly with array sections.
2015-01-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/67171
* gfortran.dg/allocate_with_source_12.f03: New test
PR fortran/61819
* gfortran.dg/allocate_with_source_13.f03: New test
PR fortran/61830
* gfortran.dg/allocate_with_source_14.f03: New test
From-SVN: r229303
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r-- | gcc/fortran/trans-array.c | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 45c18a5b418..b726998cfcd 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8024,6 +8024,38 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, build_int_cst (TREE_TYPE (comp), 0)); } gfc_add_expr_to_block (&tmpblock, tmp); + + /* Finally, reset the vptr to the declared type vtable and, if + necessary reset the _len field. + + First recover the reference to the component and obtain + the vptr. */ + comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, + decl, cdecl, NULL_TREE); + tmp = gfc_class_vptr_get (comp); + + if (UNLIMITED_POLY (c)) + { + /* Both vptr and _len field should be nulled. */ + gfc_add_modify (&tmpblock, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); + tmp = gfc_class_len_get (comp); + gfc_add_modify (&tmpblock, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); + } + else + { + /* Build the vtable address and set the vptr with it. */ + tree vtab; + gfc_symbol *vtable; + vtable = gfc_find_derived_vtab (c->ts.u.derived); + vtab = vtable->backend_decl; + if (vtab == NULL_TREE) + vtab = gfc_get_symbol_decl (vtable); + vtab = gfc_build_addr_expr (NULL, vtab); + vtab = fold_convert (TREE_TYPE (tmp), vtab); + gfc_add_modify (&tmpblock, tmp, vtab); + } } if (cmp_has_alloc_comps |