Found when looking at PR 41580 -- and related to PR47180, PR47024 and PR47189. The following programs works if "b1" was never allocated - and if it was last allocated to "t1"; it fails if it was last allocated to "t11". Thus, the vtab seems to be properly set initially; it also seems to be properly set during allocation, but it does not seem to get reset for DEALLOCATE. implicit none type t1 integer :: a end type t1 type, extends(t1):: t11 integer :: b end type t11 class(t1), allocatable :: b1 class(t11), allocatable :: b11 allocate(t11 :: b1) deallocate(b1) if (extends_type_of(b1,b11) .neqv. .false.) call abort() end
(In reply to comment #0) > Found when looking at PR 41580 -- and related to PR47180, PR47024 and PR47189. Seems we opened a nice can of worms here ;) Patch: Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 168539) +++ gcc/fortran/trans-stmt.c (working copy) @@ -4738,7 +4738,6 @@ gfc_trans_deallocate (gfc_code *code) { gfc_se se; gfc_alloc *al; - gfc_expr *expr; tree apstat, astat, pstat, stat, tmp; stmtblock_t block; @@ -4766,9 +4765,12 @@ gfc_trans_deallocate (gfc_code *code) for (al = code->ext.alloc.list; al != NULL; al = al->next) { - expr = al->expr; + gfc_expr *expr = gfc_copy_expr (al->expr); gcc_assert (expr->expr_type == EXPR_VARIABLE); + if (expr->ts.type == BT_CLASS) + gfc_add_data_component (expr); + gfc_init_se (&se, NULL); gfc_start_block (&se.pre); @@ -4797,6 +4799,7 @@ gfc_trans_deallocate (gfc_code *code) } } tmp = gfc_array_deallocate (se.expr, pstat, expr); + gfc_add_expr_to_block (&se.pre, tmp); } else { @@ -4804,13 +4807,26 @@ gfc_trans_deallocate (gfc_code *code) expr, expr->ts); gfc_add_expr_to_block (&se.pre, tmp); + /* Set to zero after deallocation. */ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); + gfc_add_expr_to_block (&se.pre, tmp); + + if (al->expr->ts.type == BT_CLASS) + { + /* Reset _vptr component. */ + gfc_expr *rhs, *lhs = gfc_copy_expr (al->expr); + gfc_symbol *vtab = gfc_find_derived_vtab (al->expr->ts.u.derived); + gfc_add_vptr_component (lhs); + rhs = gfc_lval_expr_from_sym (vtab); + tmp = gfc_trans_pointer_assignment (lhs, rhs); + gfc_add_expr_to_block (&se.pre, tmp); + gfc_free_expr (lhs); + gfc_free_expr (rhs); + } } - gfc_add_expr_to_block (&se.pre, tmp); - /* Keep track of the number of failed deallocations by adding stat of the last deallocation to the running total. */ if (code->expr1 || code->expr2) @@ -4822,7 +4838,7 @@ gfc_trans_deallocate (gfc_code *code) tmp = gfc_finish_block (&se.pre); gfc_add_expr_to_block (&block, tmp); - + gfc_free_expr (expr); } /* Set STAT. */ Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 168539) +++ gcc/fortran/resolve.c (working copy) @@ -6417,12 +6417,6 @@ resolve_deallocate_expr (gfc_expr *e) if (gfc_check_vardef_context (e, false, _("DEALLOCATE object")) == FAILURE) return FAILURE; - if (e->ts.type == BT_CLASS) - { - /* Only deallocate the DATA component. */ - gfc_add_data_component (e); - } - return SUCCESS; }
Author: janus Date: Fri Jan 7 12:08:21 2011 New Revision: 168565 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=168565 Log: 2011-01-07 Janus Weil <janus@gcc.gnu.org> PR fortran/47189 PR fortran/47194 * gfortran.h (gfc_lval_expr_from_sym): Moved prototype. * class.c (gfc_class_null_initializer): Initialize _vptr to declared type. * expr.c (gfc_lval_expr_from_sym): Moved here from symbol.c. * resolve.c (resolve_deallocate_expr): _data component will be added at translation stage. * symbol.c (gfc_lval_expr_from_sym): Moved to expr.c. * trans-stmt.c (gfc_trans_deallocate): Reset _vptr to declared type. 2011-01-07 Janus Weil <janus@gcc.gnu.org> PR fortran/47189 PR fortran/47194 * gfortran.dg/storage_size_3.f08: Extended. Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/class.c trunk/gcc/fortran/expr.c trunk/gcc/fortran/gfortran.h trunk/gcc/fortran/resolve.c trunk/gcc/fortran/symbol.c trunk/gcc/fortran/trans-stmt.c trunk/gcc/testsuite/ChangeLog trunk/gcc/testsuite/gfortran.dg/storage_size_3.f08
Fixed with r168565. Closing.