From 28114dadadfeedf9de14b51e8e2a5e5859d619e3 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 17 Jul 2007 17:22:44 +0000 Subject: re PR fortran/31320 (Illegal read with gfortran.dg/alloc_comp_assign_2.f90 and *_3.f90) 2007-07-17 Paul Thomas 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 PR fortran/31320 PR fortran/32665 * gfortran.dg/alloc_comp_constructor_3.f90: New test. From-SVN: r126703 --- gcc/fortran/ChangeLog | 11 +++ gcc/fortran/trans-expr.c | 93 ++++++++++++---------- gcc/testsuite/ChangeLog | 6 ++ .../gfortran.dg/alloc_comp_constructor_3.f90 | 16 ++++ 4 files changed, 85 insertions(+), 41 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f88667c..726fd18 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2007-07-17 Paul Thomas + + 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 PR fortran/32222 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e1a3a8c..fce6159 100644 --- a/gcc/fortran/trans-expr.c +++ b/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)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cb17867..ec808de 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-07-17 Paul Thomas + + PR fortran/31320 + PR fortran/32665 + * gfortran.dg/alloc_comp_constructor_3.f90: New test. + 2007-07-17 Zdenek Dvorak PR rtl-optimization/32773 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 new file mode 100644 index 0000000..53fa79c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 @@ -0,0 +1,16 @@ +! { 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 +! + 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 -- cgit v1.1