libgomp/testsuite/libgomp.fortran/target-11.f90

   1 ! Based on libgomp.c/target-23.c
   2
   3 ! { dg-additional-options "-fdump-tree-original" }
   4 ! { dg-final { scan-tree-dump "omp target update to\\(xxs\\\[3\\\] \\\[len: 2\\\]\\)" "original" } }
   5 ! { dg-final { scan-tree-dump "omp target update to\\(s\\.s \\\[len: 4\\\]\\)" "original" } }
   6 ! { dg-final { scan-tree-dump "omp target update from\\(s\\.s \\\[len: 4\\\]\\)" "original" } }
   7
   8 module m
   9   implicit none
  10   type S_type
  11     integer s
  12     integer, pointer :: u(:) => null()
  13     integer :: v(0:4)
  14   end type S_type
  15   integer, volatile :: z
  16 end module m
  17
  18 program main
  19   use m
  20   implicit none
  21   integer, target :: u(0:9) = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
  22   logical :: err
  23   type (S_type) :: s
  24   integer, pointer :: v(:)
  25   integer(kind=2) :: xxs(5)
  26   err = .false.
  27   s = S_type(9, v=[10, 11, 12, 13, 14])
  28   s%u(0:) => u(3:)
  29   v(-4+3:) => u(3:)
  30   xxs = [-1,-2,-3,-4,-5]
  31   !$omp target enter data map (to: s%s, s%u, s%u(0:5)) map (alloc: s%v(1:4), xxs(3:5))
  32   s%s = s%s + 1
  33   u(3) = u(3) + 1
  34   s%v(1) = s%v(1) + 1
  35   xxs(3) = -33
  36   xxs(4) = -44
  37   xxs(5) = -55
  38   !$omp target update to (xxs(4))
  39   !$omp target update to (s%s) to (s%u(0:2), s%v(1:4))
  40
  41   !$omp target map (alloc: s%s, s%v(1:4)) map (from: err)
  42     err = .false.
  43     if (s%s /= 10 .or. s%v(1) /= 12 .or. s%v(2) /= 12 .or. s%v(3) /= 13) &
  44       err = .true.
  45     if (v(-1) /= 4 .or. v(0) /= 4 .or. v(1) /= 5 .or. v(2) /= 6 .or. v(3) /= 7) &
  46       err = .true.
  47     if (xxs(4) /= -44) &
  48       err = .true.
  49     s%s = s%s + 1
  50     s%v(2) = s%v(2) + 2
  51     v(-1) = 5
  52     v(3) = 9
  53   !$omp end target
  54
  55   if (err) &
  56     error stop
  57
  58   !$omp target map (alloc: s%u(0:5))
  59     err = .false.
  60     if (s%u(0) /= 5 .or. s%u(1) /= 4 .or. s%u(2) /= 5 .or. s%u(3) /= 6 .or. s%u(4) /= 9) &
  61       err = .true.
  62     s%u(1) = 12
  63   !$omp end target
  64
  65   !$omp target update from (s%s, s%u(0:5)) from (s%v(1:4))
  66   if (err .or. s%s /= 11 .or. u(0) /= 0 .or. u(1) /= 1 .or. u(2) /= 2 .or. u(3) /= 5 &
  67       .or. u(4) /= 12 .or. u(5) /= 5 .or. u(6) /= 6 .or. u(7) /= 9 .or. u(8) /= 8    &
  68       .or. u(9) /= 9 .or. s%v(0) /= 10 .or. s%v(1) /= 12 .or. s%v(2) /= 14           &
  69       .or. s%v(3) /= 13 .or. s%v(4) /= 14)                                           &
  70     error stop
  71   ! !$omp target exit data map (release: s%s)
  72   ! !$omp target exit data map (release: s%u(0:5))
  73   ! !$omp target exit data map (delete: s%v(1:4))
  74   ! !$omp target exit data map (release: s%s)
  75 end