1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
! { dg-do run }
!
! Test the fix for PR34640. In the first version of the fix, the first
! testcase in PR51218 failed with a segfault. This test extracts the
! failing part and checks that all is well.
!
type t_info_block
integer :: n = 0 ! number of elements
end type t_info_block
!
type t_dec_info
integer :: n = 0 ! number of elements
integer :: n_b = 0 ! number of blocks
type (t_info_block) ,pointer :: b (:) => NULL() ! info blocks
end type t_dec_info
!
type t_vector_segm
integer :: n = 0 ! number of elements
real ,pointer :: x(:) => NULL() ! coefficients
end type t_vector_segm
!
type t_vector
type (t_dec_info) ,pointer :: info => NULL() ! decomposition info
integer :: n = 0 ! number of elements
integer :: n_s = 0 ! number of segments
integer :: alloc_l = 0 ! allocation level
type (t_vector_segm) ,pointer :: s (:) => NULL() ! vector blocks
end type t_vector
type(t_vector) :: z
type(t_vector_segm), pointer :: ss
allocate (z%s(2))
do i = 1, 2
ss => z%s(i)
allocate (ss%x(2), source = [1.0, 2.0]*real(i))
end do
! These lines would segfault.
if (int (sum (z%s(1)%x)) .ne. 3) STOP 1
if (int (sum (z%s(1)%x * z%s(2)%x)) .ne. 10) STOP 2
end
|
