libgomp/testsuite/libgomp.oacc-fortran/deep-copy-6.f90

   1 ! { dg-do run }
   2
   3 ! Test of attachment counters and finalize.
   4
   5 program dtype
   6   use openacc
   7   implicit none
   8   integer, parameter :: n = 512
   9   type mytype
  10     integer, allocatable :: a(:)
  11     integer, allocatable :: b(:)
  12   end type mytype
  13   integer i
  14
  15   type(mytype) :: var
  16
  17   allocate(var%a(1:n))
  18   allocate(var%b(1:n))
  19
  20 !$acc data copy(var)
  21
  22   do i = 1, n
  23     var%a(i) = 0
  24     var%b(i) = 0
  25   end do
  26
  27 !$acc enter data copyin(var%a(5:n - 5), var%b(5:n - 5))
  28
  29   do i = 1,20
  30     !$acc enter data attach(var%a)
  31   end do
  32
  33 !$acc parallel loop
  34   do i = 5,n - 5
  35     var%a(i) = i
  36     var%b(i) = i * 2
  37   end do
  38 !$acc end parallel loop
  39
  40   if (.not. acc_is_present(var%a(5:n - 5))) stop 11
  41   if (.not. acc_is_present(var%b(5:n - 5))) stop 12
  42   if (.not. acc_is_present(var)) stop 13
  43 !$acc exit data copyout(var%a(5:n - 5), var%b(5:n - 5)) finalize
  44   if (acc_get_device_type() .ne. acc_device_host) then
  45      if (acc_is_present(var%a(5:n - 5))) stop 21
  46      if (acc_is_present(var%b(5:n - 5))) stop 22
  47   end if
  48   print *, "CheCKpOInT1"
  49   ! { dg-output ".*CheCKpOInT1(\n|\r\n|\r)" }
  50   if (.not. acc_is_present(var)) stop 23
  51   !TODO { dg-output "STOP 23(\n|\r\n|\r)$" { target { ! openacc_host_selected } } } ! Scan for what we expect in the "XFAILed" case (without actually XFAILing).
  52   !TODO { dg-shouldfail "XFAILed" { ! openacc_host_selected } } ! ... instead of 'dg-xfail-run-if' so that 'dg-output' is evaluated at all.
  53   !TODO { dg-final { if { [dg-process-target { xfail { ! openacc_host_selected } }] == "F" } { xfail "[testname-for-summary] really is XFAILed" } } } ! ... so that we still get an XFAIL visible in the log.
  54   print *, "CheCKpOInT2"
  55   ! { dg-output ".CheCKpOInT2(\n|\r\n|\r)" { target { openacc_host_selected } } }
  56
  57 !$acc end data
  58
  59   do i = 1,4
  60     if (var%a(i) .ne. 0) stop 1
  61     if (var%b(i) .ne. 0) stop 2
  62   end do
  63
  64   do i = 5,n - 5
  65     if (i .ne. var%a(i)) stop 3
  66     if (i * 2 .ne. var%b(i)) stop 4
  67   end do
  68
  69   do i = n - 4,n
  70     if (var%a(i) .ne. 0) stop 5
  71     if (var%b(i) .ne. 0) stop 6
  72   end do
  73
  74   deallocate(var%a)
  75   deallocate(var%b)
  76
  77 end program dtype