diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-01-29 21:02:19 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-01-29 21:02:19 +0100 |
| commit | 4ed1b019f60ffc7d367baf51dc3cfa36f536a395 (patch) | |
| tree | d83aaa3db2f9ca3b7af658301c7d70891984792f /gcc/fortran/trans-array.c | |
| parent | 9975a30b5c5cab71620d94ddaec21517da9db12a (diff) | |
| download | gcc-4ed1b019f60ffc7d367baf51dc3cfa36f536a395.zip gcc-4ed1b019f60ffc7d367baf51dc3cfa36f536a395.tar.gz gcc-4ed1b019f60ffc7d367baf51dc3cfa36f536a395.tar.bz2 | |
re PR fortran/51972 ([OOP] Wrong code as _copy does not honor CLASS components)
2012-01-29 Tobias Burnus <burnus@net-b.de>
PR fortran/51972
* trans-array.c (structure_alloc_comps): Fix assignment of
polymorphic components (polymorphic deep copying).
2012-01-29 Tobias Burnus <burnus@net-b.de>
PR fortran/51972
* gfortran.dg/class_allocate_12.f90: Enable disabled test.
* gfortran.dg/class_48.f90: New.
From-SVN: r183680
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 51 |
1 files changed, 51 insertions, 0 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b8516af..d3c81a8 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7532,6 +7532,57 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, cdecl, NULL_TREE); dcmp = fold_convert (TREE_TYPE (comp), dcmp); + if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) + { + tree ftn_tree; + tree size; + tree dst_data; + tree src_data; + tree null_data; + + dst_data = gfc_class_data_get (dcmp); + src_data = gfc_class_data_get (comp); + size = fold_convert (size_type_node, gfc_vtable_size_get (comp)); + + if (CLASS_DATA (c)->attr.dimension) + { + nelems = gfc_conv_descriptor_size (src_data, + CLASS_DATA (c)->as->rank); + src_data = gfc_conv_descriptor_data_get (src_data); + dst_data = gfc_conv_descriptor_data_get (dst_data); + } + else + nelems = build_int_cst (size_type_node, 1); + + gfc_init_block (&tmpblock); + + /* We need to use CALLOC as _copy might try to free allocatable + components of the destination. */ + ftn_tree = builtin_decl_explicit (BUILT_IN_CALLOC); + tmp = build_call_expr_loc (input_location, ftn_tree, 2, nelems, + size); + gfc_add_modify (&tmpblock, dst_data, + fold_convert (TREE_TYPE (dst_data), tmp)); + + tmp = gfc_copy_class_to_class (comp, dcmp, nelems); + gfc_add_expr_to_block (&tmpblock, tmp); + tmp = gfc_finish_block (&tmpblock); + + gfc_init_block (&tmpblock); + gfc_add_modify (&tmpblock, dst_data, + fold_convert (TREE_TYPE (dst_data), + null_pointer_node)); + null_data = gfc_finish_block (&tmpblock); + + null_cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, src_data, + null_pointer_node); + + gfc_add_expr_to_block (&fnblock, build3_v (COND_EXPR, null_cond, + tmp, null_data)); + continue; + } + if (c->attr.allocatable && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; |