Skip to content

R
riscv-gcc-1
Commit 28114dad by Paul Thomas
Options

re PR fortran/31320 (Illegal read with gfortran.dg/alloc_comp_assign_2.f90 and *_3.f90) 

2007-07-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31320
	PR fortran/32665
	* trans-expr.c (gfc_trans_subcomponent_assign): Ensure that
	renormalization unity base is done independently of existing
	lbound value.
	(gfc_trans_scalar_assign): If rhs is not a variable, put
	lse->pre after rse->pre to ensure that de-allocation of lhs
	occurs after evaluation of rhs.

2007-07-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31320
	PR fortran/32665
	* gfortran.dg/alloc_comp_constructor_3.f90: New test.

From-SVN: r126703
parent 4c85af60
Showing with 85 additions and 41 deletions
gcc/fortran/ChangeLog
2007-07-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31320
PR fortran/32665
* trans-expr.c (gfc_trans_subcomponent_assign): Ensure that
renormalization unity base is done independently of existing
lbound value.
(gfc_trans_scalar_assign): If rhs is not a variable, put
lse->pre after rse->pre to ensure that de-allocation of lhs
occurs after evaluation of rhs.
2007-07-16 Lee Millward <lee.millward@gmail.com>
PR fortran/32222
......
gcc/fortran/trans-expr.c
......@@ -2973,65 +2973,68 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
if (cm->allocatable && expr->expr_type == EXPR_NULL)
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
else if (cm->allocatable)
{
tree tmp2;
{
tree tmp2;
gfc_init_se (&se, NULL);
rss = gfc_walk_expr (expr);
se.want_pointer = 0;
gfc_conv_expr_descriptor (&se, expr, rss);
se.want_pointer = 0;
gfc_conv_expr_descriptor (&se, expr, rss);
gfc_add_block_to_block (&block, &se.pre);
tmp = fold_convert (TREE_TYPE (dest), se.expr);
gfc_add_modify_expr (&block, dest, tmp);
if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
cm->as->rank);
else
tmp = gfc_duplicate_allocatable (dest, se.expr,
tmp = gfc_duplicate_allocatable (dest, se.expr,
TREE_TYPE(cm->backend_decl),
cm->as->rank);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &se.post);
gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
gfc_add_expr_to_block (&block, tmp);
/* Shift the lbound and ubound of temporaries to being unity, rather
than zero, based. Calculate the offset for all cases. */
offset = gfc_conv_descriptor_offset (dest);
gfc_add_modify_expr (&block, offset, gfc_index_zero_node);
tmp2 =gfc_create_var (gfc_array_index_type, NULL);
for (n = 0; n < expr->rank; n++)
{
if (expr->expr_type != EXPR_VARIABLE
&& expr->expr_type != EXPR_CONSTANT)
{
tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]);
gfc_add_modify_expr (&block, tmp,
fold_build2 (PLUS_EXPR,
gfc_array_index_type,
tmp, gfc_index_one_node));
tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]);
gfc_add_modify_expr (&block, tmp, gfc_index_one_node);
}
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound (dest,
gfc_add_block_to_block (&block, &se.post);
gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
/* Shift the lbound and ubound of temporaries to being unity, rather
than zero, based. Calculate the offset for all cases. */
offset = gfc_conv_descriptor_offset (dest);
gfc_add_modify_expr (&block, offset, gfc_index_zero_node);
tmp2 =gfc_create_var (gfc_array_index_type, NULL);
for (n = 0; n < expr->rank; n++)
{
if (expr->expr_type != EXPR_VARIABLE
&& expr->expr_type != EXPR_CONSTANT)
{
tree span;
tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]);
span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp,
gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]));
gfc_add_modify_expr (&block, tmp,
fold_build2 (PLUS_EXPR,
gfc_array_index_type,
span, gfc_index_one_node));
tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]);
gfc_add_modify_expr (&block, tmp, gfc_index_one_node);
}
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound (dest,
gfc_rank_cst[n]),
gfc_conv_descriptor_stride (dest,
gfc_conv_descriptor_stride (dest,
gfc_rank_cst[n]));
gfc_add_modify_expr (&block, tmp2, tmp);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2);
gfc_add_modify_expr (&block, offset, tmp);
}
}
gfc_add_modify_expr (&block, tmp2, tmp);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2);
gfc_add_modify_expr (&block, offset, tmp);
}
}
else
{
{
tmp = gfc_trans_subarray_assign (dest, cm, expr);
gfc_add_expr_to_block (&block, tmp);
}
}
}
else if (expr->ts.type == BT_DERIVED)
{
......@@ -3497,9 +3500,17 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
gfc_add_expr_to_block (&lse->pre, tmp);
}
gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre);
if (r_is_var)
{
gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre);
}
else
{
gfc_add_block_to_block (&block, &rse->pre);
gfc_add_block_to_block (&block, &lse->pre);
}
gfc_add_modify_expr (&block, lse->expr,
fold_convert (TREE_TYPE (lse->expr), rse->expr));
......
gcc/testsuite/ChangeLog
2007-07-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31320
PR fortran/32665
* gfortran.dg/alloc_comp_constructor_3.f90: New test.
2007-07-17 Zdenek Dvorak <dvorakz@suse.cz>
PR rtl-optimization/32773
gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 0 → 100644
! { dg-do run }
! Tests the fix for PR32665 in which the structure initializer at line
! 13 was getting the array length wrong by one and in which the automatic
! deallocation of a in 14 was occurring before the evaluation of the rhs.
!
! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
!
TYPE :: x
INTEGER, ALLOCATABLE :: a(:)
END TYPE
TYPE(x) :: a
a = x ((/ 1, 2, 3 /)) ! This is also pr31320.
a = x ((/ a%a, 4 /))
if (any (a%a .ne. (/1,2,3,4/))) 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