| ! { 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 |
