From: pault Date: Sat, 5 Jun 2010 17:51:39 +0000 (+0000) Subject: 2010-06-05 Paul Thomas X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=76e5b0d8c5279b7e76980983699fedebe5ab70e0;p=thirdparty%2Fgcc.git 2010-06-05 Paul Thomas PR fortran/43895 * trans-array.c (structure_alloc_comps): Dereference scalar 'decl' if it is a REFERENCE_TYPE. Tidy expressions containing TREE_TYPE (decl). 2010-06-05 Paul Thomas PR fortran/43895 * gfortran.dg/alloc_comp_class_1.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160326 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3830da963429..d9ab021cd87c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-06-05 Paul Thomas + + PR fortran/43895 + * trans-array.c (structure_alloc_comps): Dereference scalar + 'decl' if it is a REFERENCE_TYPE. Tidy expressions containing + TREE_TYPE (decl). + 2010-06-04 Joseph Myers * gfortranspec.c (append_arg, lang_specific_driver): Use diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7d7b3a368393..575dd0258a11 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5938,6 +5938,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_loopinfo loop; stmtblock_t fnblock; stmtblock_t loopbody; + tree decl_type; tree tmp; tree comp; tree dcmp; @@ -5951,21 +5952,28 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_block (&fnblock); - if (POINTER_TYPE_P (TREE_TYPE (decl)) && rank != 0) + decl_type = TREE_TYPE (decl); + + if ((POINTER_TYPE_P (decl_type) && rank != 0) + || (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0)) + decl = build_fold_indirect_ref_loc (input_location, decl); + /* Just in case in gets dereferenced. */ + decl_type = TREE_TYPE (decl); + /* If this an array of derived types with allocatable components build a loop and recursively call this function. */ - if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE - || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + if (TREE_CODE (decl_type) == ARRAY_TYPE + || GFC_DESCRIPTOR_TYPE_P (decl_type)) { tmp = gfc_conv_array_data (decl); var = build_fold_indirect_ref_loc (input_location, tmp); /* Get the number of elements - 1 and set the counter. */ - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + if (GFC_DESCRIPTOR_TYPE_P (decl_type)) { /* Use the descriptor for an allocatable array. Since this is a full array reference, we only need the descriptor @@ -5981,7 +5989,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, else { /* Otherwise use the TYPE_DOMAIN information. */ - tmp = array_type_nelts (TREE_TYPE (decl)); + tmp = array_type_nelts (decl_type); tmp = fold_convert (gfc_array_index_type, tmp); } @@ -5998,7 +6006,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, { if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest))) { - tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank); + tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank); gfc_add_expr_to_block (&fnblock, tmp); } tmp = build_fold_indirect_ref_loc (input_location, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4bfe09f6fea8..37caab695fc6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-05 Paul Thomas + + PR fortran/43895 + * gfortran.dg/alloc_comp_class_1.f90 : New test. + 2010-06-05 Jakub Jelinek PR c++/44361 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 new file mode 100644 index 000000000000..c783f49ff77f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! Test the fix for PR43895, in which the dummy 'a' was not +! dereferenced for the deallocation of component 'a', as required +! for INTENT(OUT). +! +! Contributed by Salvatore Filippone +! +module d_mat_mod + type :: base_sparse_mat + end type base_sparse_mat + + type, extends(base_sparse_mat) :: d_base_sparse_mat + integer :: i + end type d_base_sparse_mat + + type :: d_sparse_mat + class(d_base_sparse_mat), allocatable :: a + end type d_sparse_mat +end module d_mat_mod + + use d_mat_mod + type(d_sparse_mat) :: b + allocate (b%a) + b%a%i = 42 + call bug14 (b) + if (allocated (b%a)) call abort +contains + subroutine bug14(a) + implicit none + type(d_sparse_mat), intent(out) :: a + end subroutine bug14 +end +! { dg-final { cleanup-modules "d_mat_mod " } }