1! { dg-do run }
2! { dg-options "-fcray-pointer" }
3
4  use iso_c_binding, only : c_ptr, c_ptrdiff_t, c_loc
5  interface
6    subroutine foo (x, y, z, w)
7      use iso_c_binding, only : c_ptr
8      real, pointer :: x(:), y(:), w(:)
9      type(c_ptr) :: z
10    end subroutine
11    subroutine bar (x, y, z, w)
12      use iso_c_binding, only : c_ptr
13      real, pointer :: x(:), y(:), w(:)
14      type(c_ptr) :: z
15    end subroutine
16    subroutine baz (x, c)
17      real, pointer :: x(:)
18      real, allocatable :: c(:)
19    end subroutine
20  end interface
21  type dt
22    real, allocatable :: a(:)
23  end type
24  type (dt) :: b(64)
25  real, target :: a(4096+63)
26  real, pointer :: p(:), q(:), r(:), s(:)
27  real, allocatable :: c(:)
28  integer(c_ptrdiff_t) :: o
29  integer :: i
30  o = 64 - mod (loc (a), 64)
31  if (o == 64) o = 0
32  o = o / sizeof(0.0)
33  p => a(o + 1:o + 1024)
34  q => a(o + 1025:o + 2048)
35  r => a(o + 2049:o + 3072)
36  s => a(o + 3073:o + 4096)
37  do i = 1, 1024
38    p(i) = i
39    q(i) = i
40    r(i) = i
41    s(i) = i
42  end do
43  call foo (p, q, c_loc (r(1)), s)
44  do i = 1, 1024
45    if (p(i) /= i * i + 3 * i + 2) stop 1
46    p(i) = i
47  end do
48  call bar (p, q, c_loc (r(1)), s)
49  do i = 1, 1024
50    if (p(i) /= i * i + 3 * i + 2) stop 2
51  end do
52  ! Attempt to create 64-byte aligned allocatable
53  do i = 1, 64
54    allocate (c(1023 + i))
55    if (iand (int(loc(c(1)),8), 63_8) == 0) exit
56    deallocate (c)
57    allocate (b(i)%a(1023 + i))
58    allocate (c(1023 + i))
59    if (iand (int(loc(c(1)),8), 63_8) == 0) exit
60    deallocate (c)
61  end do
62  if (allocated (c)) then
63    do i = 1, 1024
64      c(i) = 2 * i
65    end do
66    call baz (p, c)
67    do i = 1, 1024
68      if (p(i) /= i * i + 5 * i + 2) stop 3
69    end do
70  end if
71end
72subroutine foo (x, y, z, w)
73  use iso_c_binding, only : c_ptr, c_f_pointer
74  real, pointer :: x(:), y(:), w(:), p(:)
75  type(c_ptr) :: z
76  integer :: i
77  real :: pt(1024)
78  pointer (ip, pt)
79  ip = loc (w)
80!$omp simd aligned (x, y : 64)
81  do i = 1, 1024
82    x(i) = x(i) * y(i) + 2.0
83  end do
84!$omp simd aligned (x, z : 64) private (p)
85  do i = 1, 1024
86    call c_f_pointer (z, p, shape=[1024])
87    x(i) = x(i) + p(i)
88  end do
89!$omp simd aligned (x, ip : 64)
90  do i = 1, 1024
91    x(i) = x(i) + 2 * pt(i)
92  end do
93!$omp end simd
94end subroutine
95subroutine bar (x, y, z, w)
96  use iso_c_binding, only : c_ptr, c_f_pointer
97  real, pointer :: x(:), y(:), w(:), a(:), b(:)
98  type(c_ptr) :: z, c
99  integer :: i
100  real :: pt(1024)
101  pointer (ip, pt)
102  ip = loc (w)
103  a => x
104  b => y
105  c = z
106!$omp simd aligned (a, b : 64)
107  do i = 1, 1024
108    a(i) = a(i) * b(i) + 2.0
109  end do
110!$omp simd aligned (a, c : 64)
111  do i = 1, 1024
112    block
113      real, pointer :: p(:)
114      call c_f_pointer (c, p, shape=[1024])
115      a(i) = a(i) + p(i)
116    end block
117  end do
118!$omp simd aligned (a, ip : 64)
119  do i = 1, 1024
120    a(i) = a(i) + 2 * pt(i)
121  end do
122!$omp end simd
123end subroutine
124subroutine baz (x, c)
125  real, pointer :: x(:)
126  real, allocatable :: c(:)
127  integer :: i
128!$omp simd aligned (x, c : 64)
129  do i = 1, 1024
130    x(i) = x(i) + c(i)
131  end do
132!$omp end simd
133end subroutine baz
134