diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 20 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 | 33 |
4 files changed, 59 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3830da9..d9ab021 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-06-05 Paul Thomas <pault@gcc.gnu.org> + + 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 <joseph@codesourcery.com> * gfortranspec.c (append_arg, lang_specific_driver): Use diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7d7b3a3..575dd02 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 4bfe09f..37caab6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/43895 + * gfortran.dg/alloc_comp_class_1.f90 : New test. + 2010-06-05 Jakub Jelinek <jakub@redhat.com> 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 0000000..c783f49 --- /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 <sfilippone@uniroma2.it> +! +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 " } } |