From 26219cee84430d38c60637b6fcfffcee80e11c14 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 11 Mar 2018 22:25:11 +0000 Subject: re PR fortran/84546 (Bad sourced allocation of CLASS(*) with source with CLASS(*) component) 2018-03-11 Paul Thomas 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 PR fortran/84546 * gfortran.dg/unlimited_polymorphic_29.f90 : New test. From-SVN: r258438 --- gcc/fortran/trans-array.c | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 171cebd..bd73168 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8883,6 +8883,31 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_block (&tmpblock); + gfc_add_modify (&tmpblock, gfc_class_vptr_get (dcmp), + gfc_class_vptr_get (comp)); + + /* Copy the unlimited '_len' field. If it is greater than zero + (ie. a character(_len)), multiply it by size and use this + for the malloc call. */ + if (UNLIMITED_POLY (c)) + { + tree ctmp; + gfc_add_modify (&tmpblock, gfc_class_len_get (dcmp), + gfc_class_len_get (comp)); + + size = gfc_evaluate_now (size, &tmpblock); + tmp = gfc_class_len_get (comp); + ctmp = fold_build2_loc (input_location, MULT_EXPR, + size_type_node, size, + fold_convert (size_type_node, 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, + size_type_node, tmp, ctmp, size); + size = gfc_evaluate_now (size, &tmpblock); + } + /* Coarray component have to have the same allocation status and shape/type-parameter/effective-type on the LHS and RHS of an intrinsic assignment. Hence, we did not deallocated them - and -- cgit v1.1