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