diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-10-13 10:51:21 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-10-13 10:51:21 +0200 |
| commit | 92c5266bbd5378a5513f43edf23b1394621675a3 (patch) | |
| tree | be349c6c53e4349df797771ee987f711b4e773ce /gcc/fortran/trans-intrinsic.c | |
| parent | 1202f33e5e1e4236fec7a3c1d14c16b5f13c2aaa (diff) | |
| download | gcc-92c5266bbd5378a5513f43edf23b1394621675a3.zip gcc-92c5266bbd5378a5513f43edf23b1394621675a3.tar.gz gcc-92c5266bbd5378a5513f43edf23b1394621675a3.tar.bz2 | |
re PR fortran/72832 ([OOP] ALLOCATE with SOURCE fails to allocate requested dimensions)
gcc/fortran/ChangeLog:
2016-09-01 Andre Vehreschild <vehre@gcc.gnu.org>
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 <vehre@gcc.gnu.org>
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
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 15 |
1 files changed, 13 insertions, 2 deletions
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); |