From f3b0bb7a560be0f05b09287401a10c4c4b12cfc6 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Thu, 23 Apr 2015 13:32:00 +0200 Subject: PF fortran/60322 gcc/testsuite/ChangeLog: 2015-04-23 Andre Vehreschild PF fortran/60322 * gfortran.dg/class_allocate_19.f03: New test. * gfortran.dg/class_array_20.f03: New test. * gfortran.dg/class_array_21.f03: New test. * gfortran.dg/finalize_10.f90: Corrected scan-trees. * gfortran.dg/finalize_15.f90: Fixing comparision to model initialization correctly. * gfortran.dg/finalize_29.f08: New test. gcc/fortran/ChangeLog: 2015-04-23 Andre Vehreschild PR fortran/60322 * expr.c (gfc_lval_expr_from_sym): Code to select the regular or class array added. * gfortran.h: Add IS_CLASS_ARRAY macro. * trans-array.c (gfc_add_loop_ss_code): Treat class objects to be referenced always. (build_class_array_ref): Adapt retrieval of array descriptor. (build_array_ref): Likewise. (gfc_conv_array_ref): Hand the vptr or the descriptor to build_array_ref depending whether the sym is class or not. (gfc_trans_array_cobounds): Select correct gfc_array_spec for regular and class arrays. (gfc_trans_array_bounds): Likewise. (gfc_trans_dummy_array_bias): Likewise. (gfc_get_dataptr_offset): Correcting call of build_array_ref. (gfc_conv_expr_descriptor): Set the array's offset to -1 when lbound in inner most dim is 1 and symbol non-pointer/assoc. * trans-decl.c (gfc_build_qualified_array): Select correct gfc_array_spec for regular and class arrays. (gfc_build_dummy_array_decl): Likewise. (gfc_get_symbol_decl): Get a dummy array for class arrays. (gfc_trans_deferred_vars): Tell conv_expr that the descriptor is desired. * trans-expr.c (gfc_class_vptr_get): Get the class descriptor from the correct location for class arrays. (gfc_class_len_get): Likewise. (gfc_conv_intrinsic_to_class): Add handling of _len component. (gfc_conv_class_to_class): Prevent access to unset array data when the array is an optional argument. Add handling of _len component. (gfc_copy_class_to_class): Check that _def_init is non-NULL when used in _vptr->copy() (gfc_trans_class_init_assign): Ensure that the rank of _def_init is zero. (gfc_conv_component_ref): Get the _vptr along with _data refs. (gfc_conv_variable): Make sure the temp array descriptor is returned for class arrays, too, and that class arrays are dereferenced correctly. (gfc_conv_procedure_call): For polymorphic type initialization the initializer has to be a pointer to _def_init stored in a dummy variable, which then needs to be used by value. * trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Use the temporary array descriptor for class arrays, too. (gfc_conv_intrinsic_storage_size): Likewise. (gfc_conv_intrinsic_loc): Add ref to _data for BT_CLASS expressions. * trans-stmt.c (trans_associate_var): Use a temporary array for the associate variable of class arrays, too, making the array one-based (lbound == 1). * trans-types.c (gfc_is_nodesc_array): Use the correct array data. * trans.c (gfc_build_array_ref): Use the dummy array descriptor when present. * trans.h: Add class_vptr to gfc_se for storing a class ref's vptr. From-SVN: r222361 --- gcc/fortran/trans-intrinsic.c | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-intrinsic.c') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c4ccb7b..20e5b37 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5921,8 +5921,17 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) } else if (arg->ts.type == BT_CLASS) { - if (arg->rank) + /* For deferred length arrays, conv_expr_descriptor returns an + indirect_ref to the component. */ + if (arg->rank < 0 + || (arg->rank > 0 && !VAR_P (argse.expr) + && GFC_DECL_CLASS (TREE_OPERAND (argse.expr, 0)))) byte_size = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); + else if (arg->rank > 0) + /* The scalarizer added an additional temp. To get the class' vptr + one has to look at the original backend_decl. */ + byte_size = gfc_class_vtab_size_get ( + GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl)); else byte_size = gfc_class_vtab_size_get (argse.expr); } @@ -6053,7 +6062,11 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) gfc_conv_expr_descriptor (&argse, arg); if (arg->ts.type == BT_CLASS) { - tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); + if (arg->rank > 0) + tmp = gfc_class_vtab_size_get ( + GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl)); + else + tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); tmp = fold_convert (result_type, tmp); goto done; } @@ -7080,7 +7093,11 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr) arg_expr = expr->value.function.actual->expr; if (arg_expr->rank == 0) - gfc_conv_expr_reference (se, arg_expr); + { + if (arg_expr->ts.type == BT_CLASS) + gfc_add_component_ref (arg_expr, "_data"); + gfc_conv_expr_reference (se, arg_expr); + } else gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL); se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr); -- cgit v1.1