(root)/
gcc-13.2.0/
libgomp/
testsuite/
libgomp.fortran/
struct-elem-map-1.f90
! { dg-do run }
!
! Test OpenMP 4.5 structure-element mapping

! TODO: ...%str4 + %uni4 should be tested but that currently fails due to
!       PR fortran/95868 (see commented lined)
! TODO: Test also 'var' as array and/or pointer; nested derived types,
!       type-extended types.

program main
  implicit none

  type t2
    integer :: a, b
    ! For complex, assume small integers are exactly representable
    complex(kind=8) :: c
    integer :: d(10)
    integer, pointer :: e => null(), f(:) => null()
    character(len=5) :: str1
    character(len=5) :: str2(4)
    character(len=:), pointer :: str3 => null()
    character(len=:), pointer :: str4(:) => null()
    character(kind=4, len=5) :: uni1
    character(kind=4, len=5) :: uni2(4)
    character(kind=4, len=:), pointer :: uni3 => null()
    character(kind=4, len=:), pointer :: uni4(:) => null()
  end type t2

  integer :: i

  call one ()
  call two ()
  call three ()
  call four ()
  call five ()
  call six ()
  call seven ()
  call eight ()

contains
  ! Implicitly mapped – but no pointers are mapped
  subroutine one() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "one" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%e, source=99)
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str3, source="HelloWorld")
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni3, source=4_"HelloWorld")
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

    !$omp target map(tofrom:var)
      if (var%a /= 1) stop 1
      if (var%b /= 2)  stop 2
      if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
      if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
      if (var%str1 /= "abcde") stop 5
      if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
      if (var%uni1 /= 4_"abcde") stop 7
      if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 8
    !$omp end target

    deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
  end subroutine one

  ! Explicitly mapped – all and full arrays
  subroutine two() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "two" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%e, source=99)
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str3, source="HelloWorld")
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni3, source=4_"HelloWorld")
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

    !$omp target map(tofrom: var%a, var%b, var%c, var%d, var%e, var%f, &
    !$omp&                   var%str1, var%str2, var%str3, var%str4,   &
    !$omp&                   var%uni1, var%uni2, var%uni3, var%uni4)
      if (var%a /= 1) stop 1
      if (var%b /= 2)  stop 2
      if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
      if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
      if (var%str1 /= "abcde") stop 5
      if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6

      if (.not. associated (var%e)) stop 7
      if (var%e /= 99) stop 8
      if (.not. associated (var%f)) stop 9
      if (size (var%f) /= 4) stop 10
      if (any (var%f /= [22, 33, 44, 55])) stop 11
      if (.not. associated (var%str3)) stop 12
      if (len (var%str3) /= len ("HelloWorld")) stop 13
      if (var%str3 /= "HelloWorld") stop 14
      if (.not. associated (var%str4)) stop 15
      if (len (var%str4) /= 5) stop 16
      if (size (var%str4) /= 2) stop 17
      if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18

      if (var%uni1 /= 4_"abcde") stop 19
      if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 20
      if (.not. associated (var%uni3)) stop 21
      if (len (var%uni3) /= len (4_"HelloWorld")) stop 22
      if (var%uni3 /= 4_"HelloWorld") stop 23
      if (.not. associated (var%uni4)) stop 24
      if (len (var%uni4) /= 5) stop 25
      if (size (var%uni4) /= 2) stop 26
      if (any (var%uni4 /= [4_"Let's", 4_"Go!!!"])) stop 27
    !$omp end target

    deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
  end subroutine two

  ! Explicitly mapped – one by one but full arrays
  subroutine three() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "three" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%e, source=99)
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str3, source="HelloWorld")
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni3, source=4_"HelloWorld")
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

    !$omp target map(tofrom: var%a)
      if (var%a /= 1) stop 1
    !$omp end target
    !$omp target map(tofrom: var%b)
      if (var%b /= 2)  stop 2
    !$omp end target
    !$omp target map(tofrom: var%c)
      if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
    !$omp end target
    !$omp target map(tofrom: var%d)
      if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
    !$omp end target
    !$omp target map(tofrom: var%str1)
      if (var%str1 /= "abcde") stop 5
    !$omp end target
    !$omp target map(tofrom: var%str2)
      if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
    !$omp end target

    !$omp target map(tofrom: var%e)
      if (.not. associated (var%e)) stop 7
      if (var%e /= 99) stop 8
    !$omp end target
    !$omp target map(tofrom: var%f)
      if (.not. associated (var%f)) stop 9
      if (size (var%f) /= 4) stop 10
      if (any (var%f /= [22, 33, 44, 55])) stop 11
    !$omp end target
    !$omp target map(tofrom: var%str3)
      if (.not. associated (var%str3)) stop 12
      if (len (var%str3) /= len ("HelloWorld")) stop 13
      if (var%str3 /= "HelloWorld") stop 14
    !$omp end target
    !$omp target map(tofrom: var%str4)
      if (.not. associated (var%str4)) stop 15
      if (len (var%str4) /= 5) stop 16
      if (size (var%str4) /= 2) stop 17
      if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18
    !$omp end target

    !$omp target map(tofrom: var%uni1)
      if (var%uni1 /= 4_"abcde") stop 19
    !$omp end target
    !$omp target map(tofrom: var%uni2)
      if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 20
    !$omp end target
    !$omp target map(tofrom: var%uni3)
      if (.not. associated (var%uni3)) stop 21
      if (len (var%uni3) /= len (4_"HelloWorld")) stop 22
      if (var%uni3 /= 4_"HelloWorld") stop 23
    !$omp end target
    !$omp target map(tofrom: var%uni4)
      if (.not. associated (var%uni4)) stop 24
      if (len (var%uni4) /= 5) stop 25
      if (size (var%uni4) /= 2) stop 26
      if (any (var%uni4 /= [4_"Let's", 4_"Go!!!"])) stop 27
    !$omp end target

    deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
  end subroutine three

  ! Explicitly mapped – all but only subarrays
  subroutine four() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "four" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

!   !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3)) &
!   !$omp&       map(tofrom: var%str4(2:2), var%uni2(2:3), var%uni4(2:2))
    !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3), var%uni2(2:3))
      if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
      if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6

      if (.not. associated (var%f)) stop 9
      if (size (var%f) /= 4) stop 10
      if (any (var%f(2:3) /= [33, 44])) stop 11
!     if (.not. associated (var%str4)) stop 15
!     if (len (var%str4) /= 5) stop 16
!     if (size (var%str4) /= 2) stop 17
!     if (var%str4(2) /= "Go!!!") stop 18

      if (any (var%uni2(2:3) /= [4_"67890", 4_"ABCDE"])) stop 19
!     if (.not. associated (var%uni4)) stop 20
!     if (len (var%uni4) /= 5) stop 21
!     if (size (var%uni4) /= 2) stop 22
!     if (var%uni4(2) /= "Go!!!") stop 23
    !$omp end target

    deallocate(var%f, var%str4)
  end subroutine four

  ! Explicitly mapped – all but only subarrays and one by one
  subroutine five() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "five" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str4, source=["Let's", "Go!!!"])

    !$omp target map(tofrom: var%d(4:7))
      if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
    !$omp end target
    !$omp target map(tofrom: var%str2(2:3))
      if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
    !$omp end target

    !$omp target map(tofrom: var%f(2:3))
     if (.not. associated (var%f)) stop 9
     if (size (var%f) /= 4) stop 10
     if (any (var%f(2:3) /= [33, 44])) stop 11
    !$omp end target
!  !$omp target map(tofrom: var%str4(2:2))
!     if (.not. associated (var%str4)) stop 15
!     if (len (var%str4) /= 5) stop 16
!     if (size (var%str4) /= 2) stop 17
!     if (var%str4(2) /= "Go!!!") stop 18
!   !$omp end target
!  !$omp target map(tofrom: var%uni4(2:2))
!     if (.not. associated (var%uni4)) stop 15
!     if (len (var%uni4) /= 5) stop 16
!     if (size (var%uni4) /= 2) stop 17
!     if (var%uni4(2) /= 4_"Go!!!") stop 18
!  !$omp end target

    deallocate(var%f, var%str4)
  end subroutine five

  ! Explicitly mapped – all but only array elements
  subroutine six() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "six" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

!   !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), &
!   !$omp                    var%str4(2), var%uni2(3), var%uni4(2))
    !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), var%uni2(3))
      if (var%d(5) /= -3*5) stop 4
      if (var%str2(3) /= "ABCDE") stop 6
      if (var%uni2(3) /= 4_"ABCDE") stop 7

     if (.not. associated (var%f)) stop 9
     if (size (var%f) /= 4) stop 10
     if (var%f(3) /= 44) stop 11
!     if (.not. associated (var%str4)) stop 15
!     if (len (var%str4) /= 5) stop 16
!     if (size (var%str4) /= 2) stop 17
!     if (var%str4(2) /= "Go!!!") stop 18
!     if (.not. associated (var%uni4)) stop 19
!     if (len (var%uni4) /= 5) stop 20
!     if (size (var%uni4) /= 2) stop 21
!     if (var%uni4(2) /= 4_"Go!!!") stop 22
    !$omp end target

    deallocate(var%f, var%str4, var%uni4)
  end subroutine six

  ! Explicitly mapped – all but only array elements and one by one
  subroutine seven() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "seven" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
    allocate (var%f, source=[22, 33, 44, 55])
    allocate (var%str4, source=["Let's", "Go!!!"])
    allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])

    !$omp target map(tofrom: var%d(5))
      if (var%d(5) /= (-3*5)) stop 4
    !$omp end target
    !$omp target map(tofrom: var%str2(2:3))
      if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
    !$omp end target
    !$omp target map(tofrom: var%uni2(2:3))
      if (any (var%uni2(2:3) /= [4_"67890", 4_"ABCDE"])) stop 7
    !$omp end target

    !$omp target map(tofrom: var%f(2:3))
     if (.not. associated (var%f)) stop 9
     if (size (var%f) /= 4) stop 10
     if (any (var%f(2:3) /= [33, 44])) stop 11
    !$omp end target
!   !$omp target map(tofrom: var%str4(2:2))
!     if (.not. associated (var%str4)) stop 15
!     if (len (var%str4) /= 5) stop 16
!     if (size (var%str4) /= 2) stop 17
!     if (var%str4(2) /= "Go!!!") stop 18
!   !$omp end target
!   !$omp target map(tofrom: var%uni4(2:2))
!     if (.not. associated (var%uni4)) stop 15
!     if (len (var%uni4) /= 5) stop 16
!     if (size (var%uni4) /= 2) stop 17
!     if (var%uni4(2) /= 4_"Go!!!") stop 18
!   !$omp end target

    deallocate(var%f, var%str4, var%uni4)
  end subroutine seven

  ! Check mapping of NULL pointers
  subroutine eight() 
    type(t2) :: var

    print '(g0)', '==== TESTCASE "eight" ===='

    var = t2(a = 1, &
             b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
             d = [(-3*i, i = 1, 10)], &
             str1 = "abcde", &
             str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
             uni1 = 4_"abcde", &
             uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])

!    !$omp target map(tofrom: var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
    !$omp target map(tofrom: var%e, var%str3, var%uni3)
      if (associated (var%e)) stop 1
!      if (associated (var%f)) stop 2
      if (associated (var%str3)) stop 3
!      if (associated (var%str4)) stop 4
      if (associated (var%uni3)) stop 5
!      if (associated (var%uni4)) stop 6
    !$omp end target
  end subroutine eight

end program main