gcc/testsuite/gfortran.dg/gomp/append_args-3.f90

! { dg-do compile }
! { dg-additional-options "-fdump-tree-gimple -cpp" }

module my_omp_lib
 use iso_c_binding
 implicit none

 ! The following definitions are in omp_lib, which cannot be included
 ! in gcc/testsuite/
 integer, parameter :: omp_interop_kind = c_intptr_t
 integer, parameter :: omp_interop_fr_kind = c_int

 integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind
 integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1
 integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2
 integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3
 integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4
 integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5
 integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6
 integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7
end module my_omp_lib

module m
  use my_omp_lib
  implicit none (type, external)

  integer(omp_interop_kind) :: myobj_mod, myobj2_mod
  integer(omp_interop_kind), allocatable :: myobj_mod_alloc, myobj2_mod_alloc
contains

  subroutine vsub_no_arg (o_dummy, o_value)
    integer(omp_interop_kind) :: o_dummy
    integer(omp_interop_kind), value :: o_value
  end
  subroutine sub_no_arg ()
    !$omp declare variant (vsub_no_arg ) match(construct={dispatch}) append_args (interop(targetsync), interop( target, prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} )))
  end

  integer(c_int) function vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) bind(C)
    integer(c_int), value :: arg2_int
    character(len=1, kind=c_char) :: arg2_str(*)
    integer(omp_interop_kind) :: o2_dummy
    integer(omp_interop_kind), value :: o2_value
    vfun_cbind = arg2_int
  end
  integer(c_int) function fun_cbind(arg2_int, arg2_str) bind(C)
    !$omp declare variant(vfun_cbind)  , match(construct={dispatch}),append_args (interop(target), interop(target))
    integer(c_int), value :: arg2_int
    character(len=1, kind=c_char) :: arg2_str(*)
    fun_cbind = arg2_int
  end
end

subroutine test_sub_no_arg(obj_dummy_val, obj_dummy, obj_dummy_opt, obj_dummy_alloc, obj_dummy_alloc_opt, obj_dummy_ptr, obj_dummy_ptr_opt)
  use m
  implicit none (type, external)

  integer(omp_interop_kind), value :: obj_dummy_val
  integer(omp_interop_kind) :: obj_dummy
  integer(omp_interop_kind), optional :: obj_dummy_opt

  integer(omp_interop_kind), allocatable :: obj_dummy_alloc
  integer(omp_interop_kind), allocatable, optional :: obj_dummy_alloc_opt

  integer(omp_interop_kind), pointer :: obj_dummy_ptr
  integer(omp_interop_kind), pointer, optional :: obj_dummy_ptr_opt

  integer(omp_interop_kind), target :: obj_loc
  integer(omp_interop_kind), pointer :: obj_loc_ptr
  integer(omp_interop_kind), allocatable :: obj_loc_alloc

  obj_loc = omp_interop_none
  obj_loc_ptr => obj_loc

  !$omp dispatch device(10) interop(obj_dummy_val, obj_dummy)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(10\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "obj_dummy_val\\.\[0-9\]+ = obj_dummy_val;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&obj_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(11) interop(obj_dummy, obj_dummy_val)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(11\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy, obj_dummy_val\\);" 1 "gimple" } }

  !$omp dispatch device(12) interop(obj_dummy_opt, obj_dummy_alloc)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(12\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc;" 2 "gimple" } }
  ! The follow inline shows up 4x sub_no_arg and 4x vfun_cbind
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 8 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy_opt, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(13) interop(obj_dummy_alloc, obj_dummy_opt)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(13\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_opt;" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj_dummy_alloc;
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 3 "gimple" } }

  !$omp dispatch device(14) interop(obj_dummy_alloc_opt, obj_dummy_ptr)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(14\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr;" 2 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt;" 2 "gimple" } }
  !              See above             vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\);

  !$omp dispatch device(15) interop(obj_dummy_ptr, obj_dummy_alloc_opt)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(15\\);" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt;
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
  !              See above             D\\.\[0-9\]+ = \\*obj_dummy_ptr;
  !              See above             vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\);

  !$omp dispatch device(16) interop(obj_dummy_ptr_opt, myobj_mod)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(16\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "myobj_mod\\.\[0-9\]+ = myobj_mod;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt;" 2 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+, myobj_mod\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(17) interop(myobj_mod, obj_dummy_ptr_opt)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(17\\);" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt;
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&myobj_mod, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(18) interop(obj_loc, obj_loc_ptr)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(18\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_ptr;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&obj_loc, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(19) interop(obj_loc_ptr, obj_loc)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(19\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "obj_loc\\.\[0-9\]+ = obj_loc;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_ptr, obj_loc\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(20) interop(obj_loc_alloc, myobj_mod_alloc)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(20\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "myobj_mod_alloc\\.\[0-9\]+ = myobj_mod_alloc;" 2 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*myobj_mod_alloc\\.\[0-9\]+;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_alloc, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(21) interop(myobj_mod_alloc, obj_loc_alloc)
    call sub_no_arg
  !  subroutine vsub_no_arg (o_dummy, o_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(21\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_alloc;" 1 "gimple" } }
  !              See above             myobj_mod_alloc\\.\[0-9\]+ = myobj_mod_alloc;
  ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(myobj_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
end


integer(c_int) function test_fun_cbind (obj2_dummy_val, obj2_dummy, obj2_dummy_opt, obj2_dummy_alloc, obj2_dummy_alloc_opt, obj2_dummy_ptr, obj2_dummy_ptr_opt)
  use m
  implicit none (type, external)

  integer(omp_interop_kind), value :: obj2_dummy_val
  integer(omp_interop_kind) :: obj2_dummy
  integer(omp_interop_kind), optional :: obj2_dummy_opt

  integer(omp_interop_kind), allocatable :: obj2_dummy_alloc
  integer(omp_interop_kind), allocatable, optional :: obj2_dummy_alloc_opt

  integer(omp_interop_kind), pointer :: obj2_dummy_ptr
  integer(omp_interop_kind), pointer, optional :: obj2_dummy_ptr_opt

  integer(omp_interop_kind), target :: obj2_loc
  integer(omp_interop_kind), pointer :: obj2_loc_ptr
  integer(omp_interop_kind), allocatable :: obj2_loc_alloc

  integer :: i30, i31, i32, i33, i34, i35, i36, i37, i38, i39, i40, i41

  obj2_loc = omp_interop_none
  obj2_loc_ptr => obj2_loc

  !$omp dispatch device(30) interop(obj2_dummy, obj2_dummy_val)
    i30 = fun_cbind (300, "abc30" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(30\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i30 = vfun_cbind \\(300, &\"abc30\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy, obj2_dummy_val\\);" 1 "gimple" } }

  !$omp dispatch device(31) interop(obj2_dummy_val, obj2_dummy)
    i31 = fun_cbind (301, "abc31" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(31\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "obj2_dummy_val\\.\[0-9\]+ = obj2_dummy_val;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i31 = vfun_cbind \\(301, &\"abc31\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(32) interop(obj2_dummy_opt, obj2_dummy_alloc)
    i32 = fun_cbind (302, "abc32" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(32\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_alloc;" 2 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i32 = vfun_cbind \\(302, &\"abc32\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy_opt, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(33) interop(obj2_dummy_alloc, obj2_dummy_opt)
    i33 = fun_cbind (303, "abc33" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(33\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_opt;" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj2_dummy_alloc;
  ! { dg-final { scan-tree-dump-times "i33 = vfun_cbind \\(303, &\"abc33\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(34) interop(obj2_dummy_alloc_opt, obj2_dummy_ptr)
    i34 = fun_cbind (304, "abc34" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(34\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 2 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_alloc_opt;" 2 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i34 = vfun_cbind \\(304, &\"abc34\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(35) interop(obj2_dummy_ptr, obj2_dummy_alloc_opt)
    i35 = fun_cbind (305, "abc35" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(35\\);" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj2_dummy_alloc_opt;
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i35 = vfun_cbind \\(305, &\"abc35\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(36) interop(obj2_dummy_ptr_opt, myobj2_mod)
    i36 = fun_cbind (306, "abc36" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(36\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "myobj2_mod\\.\[0-9\]+ = myobj2_mod;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt;" 2 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i36 = vfun_cbind \\(306, &\"abc36\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, myobj2_mod\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(37) interop(myobj2_mod, obj2_dummy_ptr_opt)
    i37 = fun_cbind (307, "abc37" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(37\\);" 1 "gimple" } }
  !              See above             D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt;
  !              See above             D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i37 = vfun_cbind \\(307, &\"abc37\"\\\[1\\\]\{lb: 1 sz: 1\}, &myobj2_mod, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(38) interop(obj2_loc, obj2_loc_ptr)
    i38 = fun_cbind (308, "abc38" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(38\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_ptr;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i38 = vfun_cbind \\(308, &\"abc38\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_loc, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(39) interop(obj2_loc_ptr, obj2_loc)
    i39 = fun_cbind (309, "abc39" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(39\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "obj2_loc\\.\[0-9\]+ = obj2_loc;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i39 = vfun_cbind \\(309, &\"abc39\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_ptr, obj2_loc\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(40) interop(obj2_loc_alloc, myobj2_mod_alloc)
    i40 = fun_cbind (400, "abc40" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(40\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "myobj2_mod_alloc\\.\[0-9\]+ = myobj2_mod_alloc;" 2 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*myobj2_mod_alloc\\.\[0-9\]+;" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "i40 = vfun_cbind \\(400, &\"abc40\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_alloc, D\\.\[0-9\]+\\);" 1 "gimple" } }

  !$omp dispatch device(41) interop(myobj2_mod_alloc, obj2_loc_alloc)
    i41 = fun_cbind (401, "abc41" // c_null_char)
  !  vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
  ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(41\\);" 1 "gimple" } }
  ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_alloc;" 1 "gimple" } }
  !              See above             myobj2_mod_alloc\\.\[0-9\]+ = myobj2_mod_alloc;
  ! { dg-final { scan-tree-dump-times "i41 = vfun_cbind \\(401, &\"abc41\"\\\[1\\\]\{lb: 1 sz: 1\}, myobj2_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }

  test_fun_cbind = i30 + i31 + i32 + i33 + i34 + i35 + i36 + i37 + i38 + i39 + i40 + i41
end

! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 24 "gimple" } }
! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\\.\[0-9\]+\\);" 24 "gimple" } }