diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2018-03-11 22:25:11 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2018-03-11 22:25:11 +0000 |
| commit | 26219cee84430d38c60637b6fcfffcee80e11c14 (patch) | |
| tree | 967c16a73c8b9dd9bc89ae8e0c84a1baf6462d69 /gcc/fortran/trans-expr.c | |
| parent | 1813c97a6fd41062e5154e1fb0e7e2cc762306a5 (diff) | |
| download | gcc-26219cee84430d38c60637b6fcfffcee80e11c14.zip gcc-26219cee84430d38c60637b6fcfffcee80e11c14.tar.gz gcc-26219cee84430d38c60637b6fcfffcee80e11c14.tar.bz2 | |
re PR fortran/84546 (Bad sourced allocation of CLASS(*) with source with CLASS(*) component)
2018-03-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84546
* trans-array.c (structure_alloc_comps): Make sure that the
vptr is copied and that the unlimited polymorphic _len is used
to compute the size to be allocated.
* trans-expr.c (gfc_get_class_array_ref): If unlimited, use the
unlimited polymorphic _len for the offset to the element.
(gfc_copy_class_to_class): Set the new 'unlimited' argument.
* trans.h : Add the boolean 'unlimited' to the prototype.
2018-03-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84546
* gfortran.dg/unlimited_polymorphic_29.f90 : New test.
From-SVN: r258438
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 38 |
1 files changed, 28 insertions, 10 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index c84cd10..54bda1d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1185,15 +1185,32 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, of the referenced element. */ tree -gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp) +gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp, + bool unlimited) { - tree data = data_comp != NULL_TREE ? data_comp : - gfc_class_data_get (class_decl); - tree size = gfc_class_vtab_size_get (class_decl); - tree offset = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - index, size); - tree ptr; + tree data, size, tmp, ctmp, offset, ptr; + + data = data_comp != NULL_TREE ? data_comp : + gfc_class_data_get (class_decl); + size = gfc_class_vtab_size_get (class_decl); + + if (unlimited) + { + tmp = fold_convert (gfc_array_index_type, + gfc_class_len_get (class_decl)); + ctmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, tmp); + tmp = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, tmp, + build_zero_cst (TREE_TYPE (tmp))); + size = fold_build3_loc (input_location, COND_EXPR, + gfc_array_index_type, tmp, ctmp, size); + } + + offset = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + index, size); + data = gfc_conv_descriptor_data_get (data); ptr = fold_convert (pvoid_type_node, data); ptr = fold_build_pointer_plus_loc (input_location, ptr, offset); @@ -1295,14 +1312,15 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) if (is_from_desc) { - from_ref = gfc_get_class_array_ref (index, from, from_data); + from_ref = gfc_get_class_array_ref (index, from, from_data, + unlimited); vec_safe_push (args, from_ref); } else vec_safe_push (args, from_data); if (is_to_class) - to_ref = gfc_get_class_array_ref (index, to, to_data); + to_ref = gfc_get_class_array_ref (index, to, to_data, unlimited); else { tmp = gfc_conv_array_data (to); |