diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-05-28 17:24:35 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-05-28 17:24:35 +0200 |
| commit | 4fb5478c936efb66fb417557182cb7cf7f4513b4 (patch) | |
| tree | 4946cdd562283965bd2d2588c37bb5e905e50166 /gcc/fortran/trans-stmt.c | |
| parent | 4fdf9c1ec0cc0be111e5d22d4da1cfa36a384c42 (diff) | |
| download | gcc-4fb5478c936efb66fb417557182cb7cf7f4513b4.zip gcc-4fb5478c936efb66fb417557182cb7cf7f4513b4.tar.gz gcc-4fb5478c936efb66fb417557182cb7cf7f4513b4.tar.bz2 | |
trans-expr.c (gfc_conv_procedure_call): Deallocate polymorphic arrays for allocatable intent(out) dummies.
2013-05-28 Tobias Burnus <burnus@net-b.de>
* trans-expr.c (gfc_conv_procedure_call): Deallocate
polymorphic arrays for allocatable intent(out) dummies.
(gfc_reset_vptr): New function, moved from trans-stmt.c
and extended.
* trans-stmt.c (reset_vptr): Remove.
(gfc_trans_deallocate): Update calls.
* trans.h (gfc_reset_vptr): New prototype.
2013-05-28 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/class_array_16.f90: New.
From-SVN: r199383
Diffstat (limited to 'gcc/fortran/trans-stmt.c')
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 30 |
1 files changed, 3 insertions, 27 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1b65f2c..058fd99a 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5349,30 +5349,6 @@ gfc_trans_allocate (gfc_code * code) } -/* Reset the vptr after deallocation. */ - -static void -reset_vptr (stmtblock_t *block, gfc_expr *e) -{ - gfc_expr *rhs, *lhs = gfc_copy_expr (e); - gfc_symbol *vtab; - tree tmp; - - if (UNLIMITED_POLY (e)) - rhs = gfc_get_null_expr (NULL); - else - { - vtab = gfc_find_derived_vtab (e->ts.u.derived); - rhs = gfc_lval_expr_from_sym (vtab); - } - gfc_add_vptr_component (lhs); - tmp = gfc_trans_pointer_assignment (lhs, rhs); - gfc_add_expr_to_block (block, tmp); - gfc_free_expr (lhs); - gfc_free_expr (rhs); -} - - /* Translate a DEALLOCATE statement. */ tree @@ -5453,8 +5429,8 @@ gfc_trans_deallocate (gfc_code *code) tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen, label_finish, expr); gfc_add_expr_to_block (&se.pre, tmp); - if (UNLIMITED_POLY (al->expr)) - reset_vptr (&se.pre, al->expr); + if (al->expr->ts.type == BT_CLASS) + gfc_reset_vptr (&se.pre, al->expr); } else { @@ -5469,7 +5445,7 @@ gfc_trans_deallocate (gfc_code *code) gfc_add_expr_to_block (&se.pre, tmp); if (al->expr->ts.type == BT_CLASS) - reset_vptr (&se.pre, al->expr); + gfc_reset_vptr (&se.pre, al->expr); } if (code->expr1) |