diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-11-16 14:45:29 +0100 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-11-16 14:45:29 +0100 |
| commit | dc9e0b66b22fa73f396645d7efd8b73649f2fe6b (patch) | |
| tree | e7b4f5f3869d8e0b144aa416e4efbff8d47e19d5 /gcc/fortran/trans-expr.c | |
| parent | 45a9968b378d54ced8f742e1ff8b01c9378b339c (diff) | |
| download | gcc-dc9e0b66b22fa73f396645d7efd8b73649f2fe6b.zip gcc-dc9e0b66b22fa73f396645d7efd8b73649f2fe6b.tar.gz gcc-dc9e0b66b22fa73f396645d7efd8b73649f2fe6b.tar.bz2 | |
re PR fortran/78356 ([OOP] segfault allocating polymorphic variable with polymorphic component with allocatable component)
gcc/fortran/ChangeLog:
2016-11-16 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/78356
* class.c (gfc_is_class_scalar_expr): Prevent taking an array ref for
a component ref.
* trans-expr.c (gfc_trans_assignment_1): Ensure a reference to the
object to copy is generated, when assigning class objects.
gcc/testsuite/ChangeLog:
2016-11-16 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/78356
* gfortran.dg/class_allocate_23.f08: New test.
From-SVN: r242490
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 48296b8..1331b07 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -9628,6 +9628,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, int n; bool maybe_workshare = false; symbol_attribute lhs_caf_attr, rhs_caf_attr, lhs_attr; + bool is_poly_assign; /* Assignment of the form lhs = rhs. */ gfc_start_block (&block); @@ -9648,6 +9649,19 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, || gfc_is_alloc_class_scalar_function (expr2))) expr2->must_finalize = 1; + /* Checking whether a class assignment is desired is quite complicated and + needed at two locations, so do it once only before the information is + needed. */ + lhs_attr = gfc_expr_attr (expr1); + is_poly_assign = (use_vptr_copy || lhs_attr.pointer + || (lhs_attr.allocatable && !lhs_attr.dimension)) + && (expr1->ts.type == BT_CLASS + || gfc_is_class_array_ref (expr1, NULL) + || gfc_is_class_scalar_expr (expr1) + || gfc_is_class_array_ref (expr2, NULL) + || gfc_is_class_scalar_expr (expr2)); + + /* Only analyze the expressions for coarray properties, when in coarray-lib mode. */ if (flag_coarray == GFC_FCOARRAY_LIB) @@ -9676,6 +9690,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, if (rss == gfc_ss_terminator) /* The rhs is scalar. Add a ss for the expression. */ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2); + /* When doing a class assign, then the handle to the rhs needs to be a + pointer to allow for polymorphism. */ + if (is_poly_assign && expr2->rank == 0 && !UNLIMITED_POLY (expr2)) + rss->info->type = GFC_SS_REFERENCE; /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, lss); @@ -9835,14 +9853,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, gfc_add_block_to_block (&loop.post, &rse.post); } - lhs_attr = gfc_expr_attr (expr1); - if ((use_vptr_copy || lhs_attr.pointer - || (lhs_attr.allocatable && !lhs_attr.dimension)) - && (expr1->ts.type == BT_CLASS - || (gfc_is_class_array_ref (expr1, NULL) - || gfc_is_class_scalar_expr (expr1)) - || (gfc_is_class_array_ref (expr2, NULL) - || gfc_is_class_scalar_expr (expr2)))) + if (is_poly_assign) { tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse, use_vptr_copy || (lhs_attr.allocatable |