From 92c5266bbd5378a5513f43edf23b1394621675a3 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Thu, 13 Oct 2016 10:51:21 +0200 Subject: re PR fortran/72832 ([OOP] ALLOCATE with SOURCE fails to allocate requested dimensions) gcc/fortran/ChangeLog: 2016-09-01 Andre Vehreschild PR fortran/72832 * trans-expr.c (gfc_copy_class_to_class): Add generation of runtime array bounds check. * trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to get the descriptor of a function returning a class object. * trans-stmt.c (gfc_trans_allocate): Use the array spec on the array to allocate instead of the array spec from source=. gcc/testsuite/ChangeLog: 2016-09-01 Andre Vehreschild PR fortran/72832 * gfortran.dg/allocate_with_source_22.f03: New test. * gfortran.dg/allocate_with_source_23.f03: New test. Expected to fail. From-SVN: r241088 --- gcc/fortran/trans-intrinsic.c | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-intrinsic.c') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index a499c32..9d5e33c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6544,9 +6544,20 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) if (actual->expr->ts.type == BT_CLASS) gfc_add_class_array_ref (actual->expr); - argse.want_pointer = 1; argse.data_not_needed = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); + if (gfc_is_alloc_class_array_function (actual->expr)) + { + /* For functions that return a class array conv_expr_descriptor is not + able to get the descriptor right. Therefore this special case. */ + gfc_conv_expr_reference (&argse, actual->expr); + argse.expr = gfc_build_addr_expr (NULL_TREE, + gfc_class_data_get (argse.expr)); + } + else + { + argse.want_pointer = 1; + gfc_conv_expr_descriptor (&argse, actual->expr); + } gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); arg1 = gfc_evaluate_now (argse.expr, &se->pre); -- cgit v1.1