diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-05-28 15:24:35 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-05-28 15:24:35 +0000 |
| commit | b8a601dd967e682363a8433629e1f90e5f4aee09 (patch) | |
| tree | 4946cdd562283965bd2d2588c37bb5e905e50166 /gcc/fortran/trans-stmt.c | |
| parent | d45002028b12e97178153fc82dee1b4b33f66de1 (diff) | |
| download | gcc-b8a601dd967e682363a8433629e1f90e5f4aee09.tar.gz | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@199383 138bc75d-0d04-0410-961f-82ee72b054a4
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 1b65f2ca78b..058fd99a14c 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) |