Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ! { dg-do compile }
2 ! Test the fix for PR48456 and PR48360 in which the backend
3 ! declarations for components were not located in the automatic
4 ! reallocation on assignments, thereby causing ICEs.
5 !
6 ! Contributed by Keith Refson <krefson@googlemail.com>
7 ! and Douglas Foulds <mixnmaster@gmail.com>
8 !
9 ! This is PR48360
10
11 module m
12 type mm
13 real, dimension(3,3) :: h0
14 end type mm
15 end module m
16
17 module gf33
18
19 real, allocatable, save, dimension(:,:) :: hmat
20
21 contains
22 subroutine assignit
23
24 use m
25 implicit none
26
27 type(mm) :: mmv
28
29 hmat = mmv%h0
30 end subroutine assignit
31 end module gf33
32
33 ! This is PR48456
34
35 module custom_type
36
37 integer, parameter :: dp = kind(0.d0)
38
39 type :: my_type_sub
40 real(dp), dimension(5) :: some_vector
41 end type my_type_sub
42
43 type :: my_type
44 type(my_type_sub) :: some_element
45 end type my_type
46
47 end module custom_type
48
49 module custom_interfaces
50
51 interface
52 subroutine store_data_subroutine(vec_size)
53 implicit none
54 integer, intent(in) :: vec_size
55 integer :: k
56 end subroutine store_data_subroutine
57 end interface
58
59 end module custom_interfaces
60
61 module store_data_test
62
63 use custom_type
64
65 save
66 type(my_type), dimension(:), allocatable :: some_type_to_save
67
68 end module store_data_test
69
70 program test
71
72 use store_data_test
73
74 integer :: vec_size
75
76 vec_size = 2
77
78 call store_data_subroutine(vec_size)
79 call print_after_transfer()
80
81 end program test
82
83 subroutine store_data_subroutine(vec_size)
84
85 use custom_type
86 use store_data_test
87
88 implicit none
89
90 integer, intent(in) :: vec_size
91 integer :: k
92
93 allocate(some_type_to_save(vec_size))
94
95 do k = 1,vec_size
96
97 some_type_to_save(k)%some_element%some_vector(1) = 1.0_dp
98 some_type_to_save(k)%some_element%some_vector(2) = 2.0_dp
99 some_type_to_save(k)%some_element%some_vector(3) = 3.0_dp
100 some_type_to_save(k)%some_element%some_vector(4) = 4.0_dp
101 some_type_to_save(k)%some_element%some_vector(5) = 5.0_dp
102
103 end do
104
105 end subroutine store_data_subroutine
106
107 subroutine print_after_transfer()
108
109 use custom_type
110 use store_data_test
111
112 implicit none
113
114 real(dp), dimension(:), allocatable :: C_vec
115 integer :: k
116
117 allocate(C_vec(5))
118
119 do k = 1,size(some_type_to_save)
120
121 C_vec = some_type_to_save(k)%some_element%some_vector
122 print *, "C_vec", C_vec
123
124 end do
125
126 end subroutine print_after_transfer