1! { dg-do run }
2
3! { dg-additional-sources on_device_arch.c }
4  ! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
5
6! Test tasks with detach clause on an offload device.  Each device
7! thread spawns off a chain of tasks, that can then be executed by
8! any available thread.
9
10program task_detach_6
11  use omp_lib
12
13  integer (kind=omp_event_handle_kind) :: detach_event1, detach_event2
14  integer :: x = 0, y = 0, z = 0
15  integer :: thread_count
16
17  interface
18    integer function on_device_arch_nvptx() bind(C)
19    end function on_device_arch_nvptx
20  end interface
21
22  !TODO See '../libgomp.c/pr99555-1.c'.
23  if (on_device_arch_nvptx () /= 0) then
24     call alarm (4, 0); !TODO Until resolved, make sure that we exit quickly, with error status.
25     ! { dg-xfail-run-if "PR99555" { offload_device_nvptx } }
26  end if
27
28  !$omp target map (tofrom: x, y, z) map (from: thread_count)
29    !$omp parallel private (detach_event1, detach_event2)
30      !$omp single
31	thread_count = omp_get_num_threads ()
32      !$omp end single
33
34      !$omp task detach (detach_event1) untied
35	!$omp atomic update
36	  x = x + 1
37      !$omp end task
38
39      !$omp task detach (detach_event2) untied
40	!$omp atomic update
41	  y = y + 1
42	call omp_fulfill_event (detach_event1)
43      !$omp end task
44
45      !$omp task untied
46	!$omp atomic update
47	  z = z + 1
48	call omp_fulfill_event (detach_event2)
49      !$omp end task
50    !$omp end parallel
51  !$omp end target
52
53  if (x /= thread_count) stop 1
54  if (y /= thread_count) stop 2
55  if (z /= thread_count) stop 3
56end program
57