Skip to content

R
riscv-gcc-1
Commit 0d87fa8c by Janus Weil
Options

re PR fortran/47189 ([OOP] calling STORAGE_SIZE on a NULL-initialized class pointer) 

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.

From-SVN: r168565
parent a14e5163
Showing with 88 additions and 46 deletions
gcc/fortran/ChangeLog
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-06 Daniel Franke <franke.daniel@gmail.com>
PR fortran/33117
......
gcc/fortran/class.c
......@@ -83,7 +83,8 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
/* Build a NULL initializer for CLASS pointers,
initializing the _data and _vptr components to zero. */
initializing the _data component to NULL and
the _vptr component to the declared type. */
gfc_expr *
gfc_class_null_initializer (gfc_typespec *ts)
......@@ -98,9 +99,10 @@ gfc_class_null_initializer (gfc_typespec *ts)
for (comp = ts->u.derived->components; comp; comp = comp->next)
{
gfc_constructor *ctor = gfc_constructor_get();
ctor->expr = gfc_get_expr ();
ctor->expr->expr_type = EXPR_NULL;
ctor->expr->ts = comp->ts;
if (strcmp (comp->name, "_vptr") == 0)
ctor->expr = gfc_lval_expr_from_sym (gfc_find_derived_vtab (ts->u.derived));
else
ctor->expr = gfc_get_null_expr (NULL);
gfc_constructor_append (&init->value.constructor, ctor);
}
......
gcc/fortran/expr.c
......@@ -3707,6 +3707,32 @@ gfc_get_variable_expr (gfc_symtree *var)
}
gfc_expr *
gfc_lval_expr_from_sym (gfc_symbol *sym)
{
gfc_expr *lval;
lval = gfc_get_expr ();
lval->expr_type = EXPR_VARIABLE;
lval->where = sym->declared_at;
lval->ts = sym->ts;
lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
/* It will always be a full array. */
lval->rank = sym->as ? sym->as->rank : 0;
if (lval->rank)
{
lval->ref = gfc_get_ref ();
lval->ref->type = REF_ARRAY;
lval->ref->u.ar.type = AR_FULL;
lval->ref->u.ar.dimen = lval->rank;
lval->ref->u.ar.where = sym->declared_at;
lval->ref->u.ar.as = sym->as;
}
return lval;
}
/* Returns the array_spec of a full array expression. A NULL is
returned otherwise. */
gfc_array_spec *
......
gcc/fortran/gfortran.h
......@@ -2536,8 +2536,6 @@ void gfc_free_st_label (gfc_st_label *);
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
......@@ -2701,6 +2699,7 @@ gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
bool gfc_has_default_initializer (gfc_symbol *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
......
gcc/fortran/resolve.c
......@@ -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;
}
......
gcc/fortran/symbol.c
......@@ -2245,35 +2245,6 @@ done:
}
/*******A helper function for creating new expressions*************/
gfc_expr *
gfc_lval_expr_from_sym (gfc_symbol *sym)
{
gfc_expr *lval;
lval = gfc_get_expr ();
lval->expr_type = EXPR_VARIABLE;
lval->where = sym->declared_at;
lval->ts = sym->ts;
lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
/* It will always be a full array. */
lval->rank = sym->as ? sym->as->rank : 0;
if (lval->rank)
{
lval->ref = gfc_get_ref ();
lval->ref->type = REF_ARRAY;
lval->ref->u.ar.type = AR_FULL;
lval->ref->u.ar.dimen = lval->rank;
lval->ref->u.ar.where = sym->declared_at;
lval->ref->u.ar.as = sym->as;
}
return lval;
}
/************** Symbol table management subroutines ****************/
/* Basic details: Fortran 95 requires a potentially unlimited number
......
gcc/fortran/trans-stmt.c
......@@ -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 to declared type. */
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. */
......
gcc/testsuite/ChangeLog
2011-01-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/47189
PR fortran/47194
* gfortran.dg/storage_size_3.f08: Extended.
2011-01-07 Jakub Jelinek <jakub@redhat.com>
PR c++/47022
......
gcc/testsuite/gfortran.dg/storage_size_3.f08
! { dg-do run }
!
! PR 47024: [OOP] STORAGE_SIZE (for polymorphic types): Segfault at run time
! PR 47189: [OOP] calling STORAGE_SIZE on a NULL-initialized class pointer
! PR 47194: [OOP] EXTENDS_TYPE_OF still returns the wrong result if the polymorphic variable is unallocated
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
type t
integer(kind=4) :: a
end type
class(t), pointer :: x => null()
class(t), allocatable :: y
if (storage_size(x)/=32) call abort()
if (storage_size(y)/=32) call abort()
allocate(y)
if (storage_size(y)/=32) call abort()
deallocate(y)
if (storage_size(y)/=32) call abort()
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment