This patch is perfectly obvious and fixes both regressions in one go. Bootstrapped and regtested on FC9/x86_64 - OK for trunk?
Paul PS Now for PR48462 :-) 2011-04-11 Paul Thomas <pa...@gcc.gnu.org> PR fortran/48360 PR fortran/48456 * trans-array.c (get_std_lbound): For derived type variables return array valued component lbound. 2011-04-11 Paul Thomas <pa...@gcc.gnu.org> PR fortran/48360 PR fortran/48456 * gfortran.dg/realloc_on_assign_6.f03: New test.
Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 172245) --- gcc/fortran/trans-array.c (working copy) *************** get_std_lbound (gfc_expr *expr, tree des *** 6792,6797 **** --- 6792,6799 ---- 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]; *************** get_std_lbound (gfc_expr *expr, tree des *** 6825,6830 **** --- 6827,6840 ---- 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) Index: gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 =================================================================== *** gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 (revision 0) --- gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 (revision 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 <kref...@googlemail.com> + ! and Douglas Foulds <mixnmas...@gmail.com> + ! + ! 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" } }