(root)/
gcc-13.2.0/
libgomp/
testsuite/
libgomp.fortran/
allocate-1.f90
! { dg-do run }
! { dg-additional-sources allocate-1.c }
! { dg-additional-options -Wno-complain-wrong-lang }

module m
  use omp_lib
  use iso_c_binding
  implicit none (type, external)

  interface
    integer(c_int) function is_64bit_aligned (a) bind(C)
      import :: c_int
      type(*)  :: a
    end
  end interface

contains

subroutine foo (x, p, q, h, fl)
  use omp_lib
  use iso_c_binding
  integer  :: x
  integer, dimension(4) :: p
  integer, dimension(4) :: q
  integer (kind=omp_allocator_handle_kind) :: h
  integer  :: fl

  integer  :: y
  integer  :: r, i, i1, i2, i3, i4, i5
  integer  :: l, l3, l4, l5, l6
  integer  :: n, n2, n3, n4
  integer  :: j2, j3, j4
  integer, dimension(4) :: l2
  integer, dimension(4) :: r2
  integer, target  :: xo
  integer, target  :: yo
  integer, dimension(x) :: v
  integer, dimension(x) :: w

  type s_type
    integer      :: a
    integer      :: b
  end type

  type (s_type) :: s
  s%a = 27
  s%b = 29
  y = 0
  r = 0
  n = 8
  n2 = 9
  n3 = 10
  n4 = 11
  xo = x
  yo = y

  do i = 1, 4
    r2(i) = 0;
  end do

  do i = 1, 4
    p(i) = 0;
  end do

  do i = 1, 4
    q(i) = 0;
  end do

  do i = 1, x
    w(i) = i
  end do

  !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
  if (x /= 42) then
    stop 1
  end if

  !$omp barrier
  y = 1;
  x = x + 1
  v(1) = 7
  v(42) = 8
  !$omp barrier
  if (x /= 43 .or. y /= 1) then
    stop 3
  end if
  if (v(1) /= 7 .or. v(42) /= 8) then
    stop 4
  end if
  if ( (and(fl, 2) /= 0) .and.        &
     ((is_64bit_aligned(x) == 0) .or. &
      (is_64bit_aligned(y) == 0) .or. &
      (is_64bit_aligned(v(1)) == 0))) then
    stop 2
  end if
  !$omp end parallel
  !$omp teams
  !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)

  if (x /= 42 .or. w(17) /= 17 .or. w(42) /= 42) then
    stop 5
  end if
  !$omp barrier
  y = 1;
  x = x + 1
  w(19) = w(19) + 1
  !$omp barrier
  if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
    stop 6
  end if
  if ( (and(fl, 1) /= 0) .and.          &
       ((is_64bit_aligned(x) == 0) .or. &
        (is_64bit_aligned(y) == 0) .or. &
        (is_64bit_aligned(w(1)) == 0))) then
    stop 7
  end if
  !$omp end parallel
  !$omp end teams

  !$omp parallel do private (y) firstprivate (x)  reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l)  linear (n: 16)
  do i = 0, 63
    if (x /= 42) then
      stop 8
    end if
    y = 1;
    l = i;
    n = n + y + 15;
    r = r + i;
    if ( (and(fl, 1) /= 0) .and.          &
         ((is_64bit_aligned(x) == 0) .or. &
          (is_64bit_aligned(y) == 0) .or. &
          (is_64bit_aligned(r) == 0) .or. &
          (is_64bit_aligned(l) == 0) .or. &
          (is_64bit_aligned(n) == 0))) then
      stop 9
    end if
  end do
  !$omp end parallel do

  !$omp parallel
    !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
    do i1 = 0, 63
      l2(1) = i1
      l2(2) = i1 + 1
      l2(3) = i1 + 2
      l2(4) = i1 + 3
      if (i1 < 37) then
        l3 = i1
      end if
      if ( (and(fl, 1) /= 0) .and.          &
           ((is_64bit_aligned(l2(1)) == 0) .or. &
            (is_64bit_aligned(l3) == 0) .or. &
            (is_64bit_aligned(i1) == 0))) then
        stop 10
      end if
    end do

    !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
    do i2 = 3, 4
      do j2 = 17, 22, 2
        n2 = n2 + 17
        l4 = i2 * 31 + j2
        if ( (and(fl, 1) /= 0) .and.          &
             ((is_64bit_aligned(l4) == 0) .or. &
              (is_64bit_aligned(n2) == 0) .or. &
              (is_64bit_aligned(i2) == 0) .or. &
              (is_64bit_aligned(j2) == 0))) then
          stop 11
        end if
      end do
    end do

    !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
    do i3 = 3, 4
      do j3 = 17, 22, 2
          n3 = n3 + 17
          l5 = i3 * 31 + j3
          if ( (and(fl, 2) /= 0) .and.      &
             ((is_64bit_aligned(l5) == 0) .or. &
              (is_64bit_aligned(n3) == 0) .or. &
              (is_64bit_aligned(i3) == 0) .or. &
              (is_64bit_aligned(j3) == 0))) then
          stop 12
        end if
      end do
    end do

    !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
    do i4 = 3, 4
      do j4 = 17, 22,2
          n4 = n4 + 17;
          l6 = i4 * 31 + j4;
        if ( (and(fl, 1) /= 0) .and.          &
            ((is_64bit_aligned(l6) == 0) .or. &
             (is_64bit_aligned(n4) == 0) .or. &
             (is_64bit_aligned(i4) == 0) .or. &
             (is_64bit_aligned(j4) == 0))) then
          stop 13
        end if
      end do
    end do

    !$omp do lastprivate (i5) allocate (i5)
    do i5 = 1, 17, 3
      if ( (and(fl, 2) /= 0) .and.          &
           (is_64bit_aligned(i5) == 0)) then
        stop 14
      end if
    end do

    !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
    do i = 0, 31
        p(3) = p(3) +  i;
        p(4) = p(4) + (2 * i)
        q(1) = q(1) + (3 * i)
        q(3) = q(3) + (4 * i)
        r2(1) = r2(1) + (5 * i)
        r2(4) = r2(4) + (6 * i)
        if ( (and(fl, 1) /= 0) .and.             &
             ((is_64bit_aligned(q(1)) == 0) .or. &
              (is_64bit_aligned(p(1)) == 0) .or. &
              (is_64bit_aligned(r2(1)) == 0) )) then
          stop 15
        end if
    end do

    !$omp task private(y) firstprivate(x) allocate(x, y)
    if (x /= 42) then
      stop 16
    end if

    if ( (and(fl, 2) /= 0) .and.          &
      ((is_64bit_aligned(x) == 0) .or. &
      (is_64bit_aligned(y) == 0) )) then
      stop 17
    end if
    !$omp end task

    !$omp task private(y) firstprivate(x) allocate(h: x, y)
    if (x /= 42) then
      stop 16
    end if

    if ( (and(fl, 1) /= 0) .and.          &
      ((is_64bit_aligned(x) == 0) .or. &
      (is_64bit_aligned(y) == 0) )) then
      stop 17
    end if
    !$omp end task

    !$omp task private(y) firstprivate(s) allocate(s, y)
    if (s%a /= 27 .or. s%b /= 29) then
      stop 18
    end if

    if ( (and(fl, 2) /= 0) .and.          &
      ((is_64bit_aligned(s%a) == 0) .or. &
      (is_64bit_aligned(y) == 0) )) then
      stop 19
    end if
    !$omp end task

    !$omp task private(y) firstprivate(s) allocate(h: s, y)
    if (s%a /= 27 .or. s%b /= 29) then
      stop 18
    end if

    if ( (and(fl, 1) /= 0) .and.          &
      ((is_64bit_aligned(s%a) == 0) .or. &
      (is_64bit_aligned(y) == 0) )) then
      stop 19
    end if
    !$omp end task

  !$omp end parallel

  if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
    stop 20
  end if

  if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
    stop 21
  end if

  if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
    stop 22
  end if

  if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6))  .or. l5 /= (4 * 31 + 21)) then
    stop 23
  end if

  if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6))  .or. l6 /= (4 * 31 + 21)) then
    stop 24
  end if

  if (i5 /= 19) then
    stop 24
  end if

  if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3))         &
      .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3))         &
      .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
    stop 25
  end if
end subroutine
end module m

program main
  use omp_lib
  use m
  implicit none (type, external)
  integer, dimension(4) :: p
  integer, dimension(4) :: q

  type (omp_alloctrait) :: traits(2)
  integer (omp_allocator_handle_kind) :: a

  traits = [omp_alloctrait (omp_atk_alignment, 64), &
            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
  a = omp_init_allocator (omp_default_mem_space, 2, traits)
  if (a == omp_null_allocator) stop 1

  call omp_set_default_allocator (omp_default_mem_alloc);
  call foo (42, p, q, a, 0);
  call foo (42, p, q, omp_default_mem_alloc, 0);
  call foo (42, p, q, a, 1);
  call omp_set_default_allocator (a);
  call foo (42, p, q, omp_null_allocator, 3);
  call foo (42, p, q, omp_default_mem_alloc, 2);
  call omp_destroy_allocator (a);
end