diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2020-12-26 15:08:11 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2020-12-26 15:08:11 +0000 |
| commit | 0175d45d14b1f9ebc4c15ea5bafcda655c37fc35 (patch) | |
| tree | 90de4c38ecc0351f94f38bab0097c74a633596e8 /gcc/fortran/trans-array.c | |
| parent | 9d426e4dbccf1548f2d11866fe18af04af4109de (diff) | |
| download | gcc-0175d45d14b1f9ebc4c15ea5bafcda655c37fc35.zip gcc-0175d45d14b1f9ebc4c15ea5bafcda655c37fc35.tar.gz gcc-0175d45d14b1f9ebc4c15ea5bafcda655c37fc35.tar.bz2 | |
Fix failures with -m32 and some memory leaks.
2020-12-23 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/83118
* trans-array.c (gfc_alloc_allocatable_for_assignment): Make
sure that class expressions are captured for dummy arguments by
use of gfc_get_class_from_gfc_expr otherwise the wrong vptr is
used.
* trans-expr.c (gfc_get_class_from_gfc_expr): New function.
(gfc_get_class_from_expr): If a constant expression is
encountered, return NULL_TREE;
(gfc_trans_assignment_1): Deallocate rhs allocatable components
after passing derived type function results to class lhs.
* trans.h : Add prototype for gfc_get_class_from_gfc_expr.
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 9 |
1 files changed, 9 insertions, 0 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 9e461f9..2c6be71 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -10176,6 +10176,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tree jump_label2; tree neq_size; tree lbd; + tree class_expr2 = NULL_TREE; int n; int dim; gfc_array_spec * as; @@ -10257,6 +10258,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, else if (expr1->ts.type == BT_CLASS) { tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE; + if (tmp == NULL_TREE) + tmp = gfc_get_class_from_gfc_expr (expr1); + if (tmp != NULL_TREE) { tmp2 = gfc_class_vptr_get (tmp); @@ -10332,6 +10336,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, else if (expr1->ts.type == BT_CLASS && expr2->ts.type == BT_CLASS) { tmp = expr2->rank ? gfc_get_class_from_expr (desc2) : NULL_TREE; + if (tmp == NULL_TREE && expr2->expr_type == EXPR_VARIABLE) + tmp = class_expr2 = gfc_get_class_from_gfc_expr (expr2); + if (tmp != NULL_TREE) tmp = gfc_class_vtab_size_get (tmp); else @@ -10617,6 +10624,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp2 = gfc_get_class_from_expr (desc2); tmp2 = gfc_class_vptr_get (tmp2); } + else if (expr2->ts.type == BT_CLASS && class_expr2 != NULL_TREE) + tmp2 = gfc_class_vptr_get (class_expr2); else { tmp2 = gfc_get_symbol_decl (gfc_find_vtab (&expr2->ts)); |