Fortran/gfortran/regression/gomp/dispatch-11.f90

! { dg-additional-options "-fdump-tree-original"  }

! The following definitions are in omp_lib, which cannot be included
! in gcc/testsuite/

module m
  use iso_c_binding
  implicit none (type, external)

  integer, parameter :: omp_interop_kind = c_intptr_t
  integer, parameter :: omp_interop_none = 0_omp_interop_kind

  interface
    real function repl1(); end  ! { dg-note "'declare variant' candidate 'repl1' declared here" }

    real function base1()
      !$omp declare variant(repl1) match(construct={dispatch})
    end

    subroutine repl2 (x1, x2)  ! { dg-note "'declare variant' candidate 'repl2' declared here" }
      import
      type(c_ptr), value :: x1, x2
    end
    subroutine base2 (x, y)
      import
      type(c_ptr), value :: x, y
      !$omp declare variant(repl2) match(construct={dispatch}) adjust_args(need_device_ptr : y)
    end
  end interface

contains

real function dupl (a, b)
  type(c_ptr), value :: a, b
  integer(omp_interop_kind) :: obj1, obj2
  real :: x

  !$omp dispatch interop ( obj1, obj2) device(2)
    x = base1 ()
  ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }

  !$omp dispatch device(9) interop ( obj1, obj2) nocontext(.true.)
    call base2 (a, b)
  dupl = x
end

real function test (a, b)
  type(c_ptr), value :: a, b
  integer(omp_interop_kind) :: obj1, obj2
  real :: x, y

  !$omp dispatch interop ( obj1 )
    x = base1 ()
  ! { dg-error "number of list items in 'interop' clause \\(1\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }

  !$omp dispatch interop ( obj1, obj1 ) device(42) ! Twice the same - should be fine.
    x = base1 ()
  ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }

  !$omp dispatch novariants(.true.) interop(obj2, obj1) device(0)
    y = base1 ()

  !$omp dispatch interop(obj2, obj1) device(3)
    call base2 (a, b)
  ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl2'" "" { target *-*-* } .-1 }

  !$omp dispatch interop(obj2) nocontext(.true.)
    call base2 (a, b)
  test = x + y
end
end module


! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) interop\\(obj1\\) device\\(2\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) interop\\(obj1\\) nocontext\\(1\\) device\\(9\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj1\\) device\\(42\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj2\\) novariants\\(1\\) device\\(0\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj2\\) device\\(3\\)\[\\n\\r\]" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) nocontext\\(1\\)\[\\n\\r\]" 1 "original" } }