summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03')
-rw-r--r--gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03129
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" } }