diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03')
-rw-r--r-- | gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 | 129 |
1 files changed, 129 insertions, 0 deletions
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 000000000..7c170ebce --- /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 <krefson@googlemail.com> +! and Douglas Foulds <mixnmaster@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" } } |