From 99ee02511431124acbfded6350ce5f857664560d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 12 Apr 2011 19:14:49 +0000 Subject: re PR fortran/48360 (ICE on array assignment statement with allocatable LHS) 2011-04-12 Paul Thomas PR fortran/48360 PR fortran/48456 * trans-array.c (get_std_lbound): For derived type variables return array valued component lbound. 2011-04-12 Paul Thomas PR fortran/48360 PR fortran/48456 * gfortran.dg/realloc_on_assign_6.f03: New test. From-SVN: r172339 --- gcc/fortran/ChangeLog | 7 ++ gcc/fortran/trans-array.c | 10 ++ gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 | 129 ++++++++++++++++++++++ 4 files changed, 152 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3b23770..c17ef42 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-04-12 Paul Thomas + + PR fortran/48360 + PR fortran/48456 + * trans-array.c (get_std_lbound): For derived type variables + return array valued component lbound. + 2011-04-12 Martin Jambor * trans-decl.c (gfc_generate_function_code): Call diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f8e26b0..7c34b98 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6810,6 +6810,8 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size) tree stride; tree cond, cond1, cond3, cond4; tree tmp; + gfc_ref *ref; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) { tmp = gfc_rank_cst[dim]; @@ -6843,6 +6845,14 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size) else if (expr->expr_type == EXPR_VARIABLE) { tmp = TREE_TYPE (expr->symtree->n.sym->backend_decl); + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT + && ref->u.c.component->as + && ref->next + && ref->next->u.ar.type == AR_FULL) + tmp = TREE_TYPE (ref->u.c.component->backend_decl); + } return GFC_TYPE_ARRAY_LBOUND(tmp, dim); } else if (expr->expr_type == EXPR_FUNCTION) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 61ff1c6..afb9e8a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-04-12 Paul Thomas + + PR fortran/48360 + PR fortran/48456 + * gfortran.dg/realloc_on_assign_6.f03: New test. + 2011-04-12 Kai Tietz * g++.dg/ext/bitfield2.C: Add for i?86/x86_64-*-mingw* diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 new file mode 100644 index 0000000..7c170eb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 @@ -0,0 +1,129 @@ +! { dg-do compile } +! Test the fix for PR48456 and PR48360 in which the backend +! declarations for components were not located in the automatic +! reallocation on assignments, thereby causing ICEs. +! +! Contributed by Keith Refson +! and Douglas Foulds +! +! This is PR48360 + +module m + type mm + real, dimension(3,3) :: h0 + end type mm +end module m + +module gf33 + + real, allocatable, save, dimension(:,:) :: hmat + +contains + subroutine assignit + + use m + implicit none + + type(mm) :: mmv + + hmat = mmv%h0 + end subroutine assignit +end module gf33 + +! This is PR48456 + +module custom_type + +integer, parameter :: dp = kind(0.d0) + +type :: my_type_sub + real(dp), dimension(5) :: some_vector +end type my_type_sub + +type :: my_type + type(my_type_sub) :: some_element +end type my_type + +end module custom_type + +module custom_interfaces + +interface + subroutine store_data_subroutine(vec_size) + implicit none + integer, intent(in) :: vec_size + integer :: k + end subroutine store_data_subroutine +end interface + +end module custom_interfaces + +module store_data_test + +use custom_type + +save +type(my_type), dimension(:), allocatable :: some_type_to_save + +end module store_data_test + +program test + +use store_data_test + +integer :: vec_size + +vec_size = 2 + +call store_data_subroutine(vec_size) +call print_after_transfer() + +end program test + +subroutine store_data_subroutine(vec_size) + +use custom_type +use store_data_test + +implicit none + +integer, intent(in) :: vec_size +integer :: k + +allocate(some_type_to_save(vec_size)) + +do k = 1,vec_size + + some_type_to_save(k)%some_element%some_vector(1) = 1.0_dp + some_type_to_save(k)%some_element%some_vector(2) = 2.0_dp + some_type_to_save(k)%some_element%some_vector(3) = 3.0_dp + some_type_to_save(k)%some_element%some_vector(4) = 4.0_dp + some_type_to_save(k)%some_element%some_vector(5) = 5.0_dp + +end do + +end subroutine store_data_subroutine + +subroutine print_after_transfer() + +use custom_type +use store_data_test + +implicit none + +real(dp), dimension(:), allocatable :: C_vec +integer :: k + +allocate(C_vec(5)) + +do k = 1,size(some_type_to_save) + + C_vec = some_type_to_save(k)%some_element%some_vector + print *, "C_vec", C_vec + +end do + +end subroutine print_after_transfer +! { dg-final { cleanup-modules "m gf33" } } +! { dg-final { cleanup-modules "custom_type custom_interfaces" } } +! { dg-final { cleanup-modules "store_data_test" } } -- cgit v1.1