1! { dg-do run }
2! { dg-options "-fcoarray=lib -lcaf_single" }
3! { dg-additional-options "-latomic" { target libatomic_available } }
4
5! Contributed by Damian Rouson
6! Check the new _caf_send_by_ref()-routine.
7! Same as coarray_alloc_comp_2 but for pointers.
8
9program main
10
11implicit none
12
13type :: mytype
14  integer :: i
15  integer, pointer :: indices(:)
16  real, dimension(2,5,3) :: volume
17  integer, pointer :: scalar
18  integer :: j
19  integer, pointer :: matrix(:,:)
20  real, pointer :: dynvol(:,:,:)
21end type
22
23type arrtype
24  type(mytype), pointer :: vec(:)
25  type(mytype), pointer :: mat(:,:)
26end type arrtype
27
28type(mytype), save :: object[*]
29type(arrtype), save :: bar[*]
30integer :: i,j,me,neighbor
31integer :: idx(5)
32real, allocatable :: volume(:,:,:), vol2(:,:,:)
33real :: vol_static(2,5,3)
34
35idx = (/ 1,2,1,7,5 /)
36
37me=this_image()
38neighbor = merge(1,me+1,me==num_images())
39allocate(object%indices(5), object%scalar, object%matrix(10,7), object%dynvol(2,5,3))
40object[neighbor]%indices=[(i,i=1,5)]
41object[neighbor]%i = 37
42object[neighbor]%scalar = 42
43vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
44object[neighbor]%volume = vol_static
45object[neighbor]%matrix = reshape([(i, i=1, 70)], [10, 7])
46object[neighbor]%dynvol = vol_static
47sync all
48if (object%scalar /= 42) STOP 1
49if (any( object%indices /= [1,2,3,4,5] )) STOP 2
50if (any( object%matrix /= reshape([(i, i=1, 70)], [10, 7]))) STOP 3
51if (any( object%volume /= vol_static)) STOP 4
52if (any( object%dynvol /= vol_static)) STOP 5
53
54vol2 = vol_static
55vol2(:, ::2, :) = 42
56object[neighbor]%volume(:, ::2, :) = 42
57object[neighbor]%dynvol(:, ::2, :) = 42
58if (any( object%volume /= vol2)) STOP 6
59if (any( object%dynvol /= vol2)) STOP 7
60
61allocate(bar%vec(-2:2))
62
63bar[neighbor]%vec(1)%volume = vol_static
64if (any(bar%vec(1)%volume /= vol_static)) STOP 8
65
66allocate(bar%vec(1)%scalar, bar%vec(0)%scalar, bar%vec(1)%indices(3))
67i = 15
68bar[neighbor]%vec(1)%scalar = i
69if (.not. associated(bar%vec(1)%scalar)) STOP 9
70if (bar%vec(1)%scalar /= 15) STOP 10
71
72bar[neighbor]%vec(0)%scalar = 27
73if (.not. associated(bar%vec(0)%scalar)) STOP 11
74if (bar%vec(0)%scalar /= 27) STOP 12
75
76bar[neighbor]%vec(1)%indices = [ 3, 4, 15 ]
77allocate(bar%vec(2)%indices(5))
78bar[neighbor]%vec(2)%indices = 89
79
80if (.not. associated(bar%vec(1)%indices)) STOP 13
81if (associated(bar%vec(-2)%indices)) STOP 14
82if (associated(bar%vec(-1)%indices)) STOP 15
83if (associated(bar%vec( 0)%indices)) STOP 16
84if (.not. associated(bar%vec( 2)%indices)) STOP 17
85if (any(bar%vec(2)%indices /= 89)) STOP 18
86
87if (any (bar%vec(1)%indices /= [ 3,4,15])) STOP 19
88end program
89