aboutsummaryrefslogtreecommitdiff
path: root/libgomp/testsuite/libgomp.fortran
diff options
context:
space:
mode:
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable-comp.f9053
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90121
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90124
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f9053
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90308
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90672
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90268
-rw-r--r--libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90559
8 files changed, 2158 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90 b/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
new file mode 100644
index 0000000..383ecba
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
@@ -0,0 +1,53 @@
+implicit none
+type t
+ integer, allocatable :: a, b(:)
+end type t
+type(t) :: x, y, z
+integer :: i
+
+!$omp target map(to: x)
+ if (allocated(x%a)) stop 1
+ if (allocated(x%b)) stop 2
+!$omp end target
+
+allocate(x%a, x%b(-4:6))
+x%b(:) = [(i, i=-4,6)]
+
+!$omp target map(to: x)
+ if (.not. allocated(x%a)) stop 3
+ if (.not. allocated(x%b)) stop 4
+ if (lbound(x%b,1) /= -4) stop 5
+ if (ubound(x%b,1) /= 6) stop 6
+ if (any (x%b /= [(i, i=-4,6)])) stop 7
+!$omp end target
+
+
+! The following only works with arrays due to
+! PR fortran/96668
+
+!$omp target enter data map(to: y, z)
+
+!$omp target map(to: y, z)
+ if (allocated(y%b)) stop 8
+ if (allocated(z%b)) stop 9
+!$omp end target
+
+allocate(y%b(5), z%b(3))
+y%b = 42
+z%b = 99
+
+! (implicitly) 'tofrom' mapped
+! Planned for OpenMP 6.0 (but common extension)
+! OpenMP <= 5.0 unclear
+!$omp target map(to: y)
+ if (.not.allocated(y%b)) stop 10
+ if (any (y%b /= 42)) stop 11
+!$omp end target
+
+! always map: OpenMP 5.1 (clarified)
+!$omp target map(always, tofrom: z)
+ if (.not.allocated(z%b)) stop 12
+ if (any (z%b /= 99)) stop 13
+!$omp end target
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
new file mode 100644
index 0000000..9d48c7c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
@@ -0,0 +1,121 @@
+type t2
+ integer x, y, z
+end type t2
+type t
+ integer, allocatable :: A
+ integer, allocatable :: B(:)
+ type(t2), allocatable :: C
+ type(t2), allocatable :: D(:,:)
+end type t
+
+type t3
+ type(t) :: Q
+ type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+
+! --------------------------------------
+! Assign + allocate
+var%A = 45
+var%B = [1,2,3]
+var%C = t2(6,5,4)
+var%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var2%A = 145
+var2%B = [991,992,993]
+var2%C = t2(996,995,994)
+var2%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+
+!$omp target map(to: var) map(tofrom: var2)
+ call foo(var, var2)
+!$omp end target
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+if (any (var2%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 12
+if (any (var2%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 12
+if (any (var2%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 12
+
+! --------------------------------------
+! Assign + allocate
+var3%Q%A = 45
+var3%Q%B = [1,2,3]
+var3%Q%C = t2(6,5,4)
+var3%Q%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+var3%R(2)%A = 45
+var3%R(2)%B = [1,2,3]
+var3%R(2)%C = t2(6,5,4)
+var3%R(2)%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var4%Q%A = 145
+var4%Q%B = [991,992,993]
+var4%Q%C = t2(996,995,994)
+var4%Q%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+var4%R(3)%A = 145
+var4%R(3)%B = [991,992,993]
+var4%R(3)%C = t2(996,995,994)
+var4%R(3)%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+!$omp target map(to: var3%Q) map(tofrom: var4%Q)
+ call foo(var3%Q, var4%Q)
+!$omp end target
+
+!$omp target map(to: var3%R(2)) map(tofrom: var4%R(3))
+ call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+if (any (var4%Q%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 16
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+if (any (var4%R(3)%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 20
+
+contains
+ subroutine foo(x, y)
+ type(t) :: x, y
+ if (x%A /= 45) stop 1
+ if (any (x%B /= [1,2,3])) stop 2
+ if (x%C%x /= 6) stop 3
+ if (x%C%y /= 5) stop 3
+ if (x%C%z /= 4) stop 3
+ if (any (x%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 4
+ if (any (x%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 4
+ if (any (x%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 4
+
+ if (y%A /= 145) stop 5
+ if (any (y%B /= [991,992,993])) stop 6
+ if (y%C%x /= 996) stop 7
+ if (y%C%y /= 995) stop 7
+ if (y%C%z /= 994) stop 7
+ if (any (y%D(:,:)%x /= reshape([199, 499, 1199, 1499], [2,2]))) stop 8
+ if (any (y%D(:,:)%y /= reshape([299, 599, 1299, 1599], [2,2]))) stop 8
+ if (any (y%D(:,:)%z /= reshape([399, 699, 1399, 1699], [2,2]))) stop 8
+
+ y%A = x%A
+ y%B(:) = x%B
+ y%C = x%C
+ y%D(:,:) = x%D(:,:)
+ end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
new file mode 100644
index 0000000..fb9859d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
@@ -0,0 +1,124 @@
+type t2
+ integer x, y, z
+end type t2
+type t
+ integer, allocatable :: A
+ integer, allocatable :: B(:)
+ type(t2), allocatable :: C
+ type(t2), allocatable :: D(:,:)
+end type t
+
+type t3
+ type(t) :: Q
+ type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+
+! --------------------------------------
+! Assign + allocate
+var%A = 45
+var%B = [1,2,3]
+var%C = t2(6,5,4)
+var%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var2%A = 145
+var2%B = [991,992,993]
+var2%C = t2(996,995,994)
+var2%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+
+!$omp target map(to: var%A, var%B, var%C, var%D) &
+!$omp& map(tofrom: var2%A, var2%B, var2%C, var2%D)
+ call foo(var, var2)
+!$omp end target
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+if (any (var2%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 12
+if (any (var2%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 12
+if (any (var2%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 12
+
+! --------------------------------------
+! Assign + allocate
+var3%Q%A = 45
+var3%Q%B = [1,2,3]
+var3%Q%C = t2(6,5,4)
+var3%Q%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+var3%R(2)%A = 45
+var3%R(2)%B = [1,2,3]
+var3%R(2)%C = t2(6,5,4)
+var3%R(2)%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var4%Q%A = 145
+var4%Q%B = [991,992,993]
+var4%Q%C = t2(996,995,994)
+var4%Q%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+var4%R(3)%A = 145
+var4%R(3)%B = [991,992,993]
+var4%R(3)%C = t2(996,995,994)
+var4%R(3)%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+!$omp target map(to: var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D) &
+!$omp& map(tofrom: var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+ call foo(var3%Q, var4%Q)
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+if (any (var4%Q%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 16
+
+!$omp target map(to: var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D) &
+!$omp& map(tofrom: var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+ call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+if (any (var4%R(3)%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 20
+
+contains
+ subroutine foo(x, y)
+ type(t) :: x, y
+ if (x%A /= 45) stop 1
+ if (any (x%B /= [1,2,3])) stop 2
+ if (x%C%x /= 6) stop 3
+ if (x%C%y /= 5) stop 3
+ if (x%C%z /= 4) stop 3
+ if (any (x%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 4
+ if (any (x%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 4
+ if (any (x%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 4
+
+ if (y%A /= 145) stop 5
+ if (any (y%B /= [991,992,993])) stop 6
+ if (y%C%x /= 996) stop 7
+ if (y%C%y /= 995) stop 7
+ if (y%C%z /= 994) stop 7
+ if (any (y%D(:,:)%x /= reshape([199, 499, 1199, 1499], [2,2]))) stop 8
+ if (any (y%D(:,:)%y /= reshape([299, 599, 1299, 1599], [2,2]))) stop 8
+ if (any (y%D(:,:)%z /= reshape([399, 699, 1399, 1699], [2,2]))) stop 8
+
+ y%A = x%A
+ y%B(:) = x%B
+ y%C = x%C
+ y%D(:,:) = x%D(:,:)
+ end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
new file mode 100644
index 0000000..b2e36b2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
@@ -0,0 +1,53 @@
+implicit none
+type t
+ integer, allocatable :: a, b(:)
+end type t
+type(t) :: x, y, z
+integer :: i
+
+!$omp target
+ if (allocated(x%a)) stop 1
+ if (allocated(x%b)) stop 2
+!$omp end target
+
+allocate(x%a, x%b(-4:6))
+x%b(:) = [(i, i=-4,6)]
+
+!$omp target
+ if (.not. allocated(x%a)) stop 3
+ if (.not. allocated(x%b)) stop 4
+ if (lbound(x%b,1) /= -4) stop 5
+ if (ubound(x%b,1) /= 6) stop 6
+ if (any (x%b /= [(i, i=-4,6)])) stop 7
+!$omp end target
+
+
+! The following only works with arrays due to
+! PR fortran/96668
+
+!$omp target enter data map(to: y, z)
+
+!$omp target
+ if (allocated(y%b)) stop 8
+ if (allocated(z%b)) stop 9
+!$omp end target
+
+allocate(y%b(5), z%b(3))
+y%b = 42
+z%b = 99
+
+! (implicitly) 'tofrom' mapped
+! Planned for OpenMP 6.0 (but common extension)
+! OpenMP <= 5.0 unclear
+!$omp target
+ if (.not.allocated(y%b)) stop 10
+ if (any (y%b /= 42)) stop 11
+!$omp end target
+
+! always map: OpenMP 5.1 (clarified)
+!$omp target map(always, tofrom: z)
+ if (.not.allocated(z%b)) stop 12
+ if (any (z%b /= 99)) stop 13
+!$omp end target
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
new file mode 100644
index 0000000..48d4aea
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
@@ -0,0 +1,308 @@
+! NOTE: This code uses POINTER.
+! While map(p, var%p) etc. maps the ptr/ptr comp p / var%p (incl. allocatable comps),
+! map(var) does not map var%p.
+
+use iso_c_binding
+implicit none
+type t2
+ integer, allocatable :: x, y, z
+end type t2
+type t
+ integer, pointer :: A => null()
+ integer, pointer :: B(:) => null()
+ type(t2), pointer :: C => null()
+ type(t2), pointer :: D(:,:) => null()
+end type t
+
+type t3
+ type(t) :: Q
+ type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+integer(c_intptr_t) :: iptr
+
+! --------------------------------------
+! Assign + allocate
+allocate (var%A, source=45)
+allocate (var%B(3), source=[1,2,3])
+allocate (var%C)
+var%C%x = 6; var%C%y = 5; var%C%z = 4
+allocate (var%D(2,2))
+var%D(1,1)%x = 1
+var%D(1,1)%y = 2
+var%D(1,1)%z = 3
+var%D(2,1)%x = 4
+var%D(2,1)%y = 5
+var%D(2,1)%z = 6
+var%D(1,2)%x = 11
+var%D(1,2)%y = 12
+var%D(1,2)%z = 13
+var%D(2,2)%x = 14
+var%D(2,2)%y = 15
+var%D(2,2)%z = 16
+
+! Assign + allocate
+allocate (var2%A, source=145)
+allocate (var2%B, source=[991,992,993])
+allocate (var2%C)
+var2%C%x = 996; var2%C%y = 995; var2%C%z = 994
+allocate (var2%D(2,2))
+var2%D(1,1)%x = 199
+var2%D(1,1)%y = 299
+var2%D(1,1)%z = 399
+var2%D(2,1)%x = 499
+var2%D(2,1)%y = 599
+var2%D(2,1)%z = 699
+var2%D(1,2)%x = 1199
+var2%D(1,2)%y = 1299
+var2%D(1,2)%z = 1399
+var2%D(2,2)%x = 1499
+var2%D(2,2)%y = 1599
+var2%D(2,2)%z = 1699
+
+block
+ integer(c_intptr_t) :: loc_a, loc_b, loc_c, loc_d, loc2_a, loc2_b, loc2_c, loc2_d
+ loc_a = loc (var%a)
+ loc_b = loc (var%b)
+ loc_c = loc (var%d)
+ loc_d = loc (var%d)
+ loc2_a = loc (var2%a)
+ loc2_b = loc (var2%b)
+ loc2_c = loc (var2%c)
+ loc2_d = loc (var2%d)
+ ! var/var2 are mapped, but the pointer components aren't
+ !$omp target map(to: var) map(tofrom: var2)
+ if (loc_a /= loc (var%a)) stop 31
+ if (loc_b /= loc (var%b)) stop 32
+ if (loc_c /= loc (var%d)) stop 33
+ if (loc_d /= loc (var%d)) stop 34
+ if (loc2_a /= loc (var2%a)) stop 35
+ if (loc2_b /= loc (var2%b)) stop 36
+ if (loc2_c /= loc (var2%c)) stop 37
+ if (loc2_d /= loc (var2%d)) stop 38
+ !$omp end target
+ if (loc_a /= loc (var%a)) stop 41
+ if (loc_b /= loc (var%b)) stop 42
+ if (loc_c /= loc (var%d)) stop 43
+ if (loc_d /= loc (var%d)) stop 44
+ if (loc2_a /= loc (var2%a)) stop 45
+ if (loc2_b /= loc (var2%b)) stop 46
+ if (loc2_c /= loc (var2%c)) stop 47
+ if (loc2_d /= loc (var2%d)) stop 48
+end block
+
+block
+ ! Map only (all) components, but this maps also the alloc comps
+ !$omp target map(to: var%a, var%b, var%c, var%d) map(tofrom: var2%a, var2%b, var2%c, var2%d)
+ call foo (var,var2)
+ !$omp end target
+end block
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+block
+ integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+ tmp_x = reshape([1, 4, 11, 14], [2,2])
+ tmp_y = reshape([2, 5, 12, 15], [2,2])
+ tmp_z = reshape([3, 6, 13, 16], [2,2])
+ do j = 1, 2
+ do i = 1, 2
+ if (var2%D(i,j)%x /= tmp_x(i,j)) stop 12
+ if (var2%D(i,j)%y /= tmp_y(i,j)) stop 12
+ if (var2%D(i,j)%z /= tmp_z(i,j)) stop 12
+ end do
+ end do
+end block
+
+! Extra deallocates due to PR fortran/104697
+deallocate(var%C%x, var%C%y, var%C%z)
+deallocate(var%D(1,1)%x, var%D(1,1)%y, var%D(1,1)%z)
+deallocate(var%D(2,1)%x, var%D(2,1)%y, var%D(2,1)%z)
+deallocate(var%D(1,2)%x, var%D(1,2)%y, var%D(1,2)%z)
+deallocate(var%D(2,2)%x, var%D(2,2)%y, var%D(2,2)%z)
+deallocate(var%A, var%B, var%C, var%D)
+
+deallocate(var2%C%x, var2%C%y, var2%C%z)
+deallocate(var2%D(1,1)%x, var2%D(1,1)%y, var2%D(1,1)%z)
+deallocate(var2%D(2,1)%x, var2%D(2,1)%y, var2%D(2,1)%z)
+deallocate(var2%D(1,2)%x, var2%D(1,2)%y, var2%D(1,2)%z)
+deallocate(var2%D(2,2)%x, var2%D(2,2)%y, var2%D(2,2)%z)
+deallocate(var2%A, var2%B, var2%C, var2%D)
+
+! --------------------------------------
+! Assign + allocate
+allocate (var3%Q%A, source=45)
+allocate (var3%Q%B, source=[1,2,3])
+allocate (var3%Q%C, source=t2(6,5,4))
+allocate (var3%Q%D(2,2))
+var3%Q%D(1,1) = t2(1,2,3)
+var3%Q%D(2,1) = t2(4,5,6)
+var3%Q%D(1,2) = t2(11,12,13)
+var3%Q%D(2,2) = t2(14,15,16)
+
+allocate (var3%R(2)%A, source=45)
+allocate (var3%R(2)%B, source=[1,2,3])
+allocate (var3%R(2)%C, source=t2(6,5,4))
+allocate (var3%R(2)%D(2,2))
+var3%R(2)%D(1,1) = t2(1,2,3)
+var3%R(2)%D(2,1) = t2(4,5,6)
+var3%R(2)%D(1,2) = t2(11,12,13)
+var3%R(2)%D(2,2) = t2(14,15,16)
+
+! Assign + allocate
+allocate (var4%Q%A, source=145)
+allocate (var4%Q%B, source=[991,992,993])
+allocate (var4%Q%C, source=t2(996,995,994))
+allocate (var4%Q%D(2,2))
+var4%Q%D(1,1) = t2(199,299,399)
+var4%Q%D(2,1) = t2(499,599,699)
+var4%Q%D(1,2) = t2(1199,1299,1399)
+var4%Q%D(2,2) = t2(1499,1599,1699)
+
+allocate (var4%R(3)%A, source=145)
+allocate (var4%R(3)%B, source=[991,992,993])
+allocate (var4%R(3)%C, source=t2(996,995,994))
+allocate (var4%R(3)%D(2,2))
+var4%R(3)%D(1,1) = t2(199,299,399)
+var4%R(3)%D(2,1) = t2(499,599,699)
+var4%R(3)%D(1,2) = t2(1199,1299,1399)
+var4%R(3)%D(2,2) = t2(1499,1599,1699)
+
+!$omp target map(to: var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D) &
+!$omp& map(tofrom: var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+ call foo(var3%Q, var4%Q)
+!$omp end target
+
+iptr = loc(var3%R(2)%A)
+
+!$omp target map(to: var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D) &
+!$omp& map(tofrom: var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+ call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+block
+ integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+ tmp_x = reshape([1, 4, 11, 14], [2,2])
+ tmp_y = reshape([2, 5, 12, 15], [2,2])
+ tmp_z = reshape([3, 6, 13, 16], [2,2])
+ do j = 1, 2
+ do i = 1, 2
+ if (var4%Q%D(i,j)%x /= tmp_x(i,j)) stop 16
+ if (var4%Q%D(i,j)%y /= tmp_y(i,j)) stop 16
+ if (var4%Q%D(i,j)%z /= tmp_z(i,j)) stop 16
+ end do
+ end do
+end block
+
+! Cf. PR fortran/104696
+! { dg-output "valid mapping, OK" { xfail { offload_device_nonshared_as } } }
+if (iptr /= loc(var3%R(2)%A)) then
+ print *, "invalid mapping, cf. PR fortran/104696"
+else
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+block
+ integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+ tmp_x = reshape([1, 4, 11, 14], [2,2])
+ tmp_y = reshape([2, 5, 12, 15], [2,2])
+ tmp_z = reshape([3, 6, 13, 16], [2,2])
+ do j = 1, 2
+ do i = 1, 2
+ if (var4%R(3)%D(i,j)%x /= tmp_x(i,j)) stop 20
+ if (var4%R(3)%D(i,j)%y /= tmp_y(i,j)) stop 20
+ if (var4%R(3)%D(i,j)%z /= tmp_z(i,j)) stop 20
+ end do
+ end do
+end block
+
+! Extra deallocates due to PR fortran/104697
+deallocate(var3%Q%C%x, var3%Q%D(1,1)%x, var3%Q%D(2,1)%x, var3%Q%D(1,2)%x, var3%Q%D(2,2)%x)
+deallocate(var3%Q%C%y, var3%Q%D(1,1)%y, var3%Q%D(2,1)%y, var3%Q%D(1,2)%y, var3%Q%D(2,2)%y)
+deallocate(var3%Q%C%z, var3%Q%D(1,1)%z, var3%Q%D(2,1)%z, var3%Q%D(1,2)%z, var3%Q%D(2,2)%z)
+deallocate(var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D)
+
+deallocate(var4%Q%C%x, var4%Q%D(1,1)%x, var4%Q%D(2,1)%x, var4%Q%D(1,2)%x, var4%Q%D(2,2)%x)
+deallocate(var4%Q%C%y, var4%Q%D(1,1)%y, var4%Q%D(2,1)%y, var4%Q%D(1,2)%y, var4%Q%D(2,2)%y)
+deallocate(var4%Q%C%z, var4%Q%D(1,1)%z, var4%Q%D(2,1)%z, var4%Q%D(1,2)%z, var4%Q%D(2,2)%z)
+deallocate(var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+
+deallocate(var3%R(2)%C%x, var3%R(2)%D(1,1)%x, var3%R(2)%D(2,1)%x, var3%R(2)%D(1,2)%x, var3%R(2)%D(2,2)%x)
+deallocate(var3%R(2)%C%y, var3%R(2)%D(1,1)%y, var3%R(2)%D(2,1)%y, var3%R(2)%D(1,2)%y, var3%R(2)%D(2,2)%y)
+deallocate(var3%R(2)%C%z, var3%R(2)%D(1,1)%z, var3%R(2)%D(2,1)%z, var3%R(2)%D(1,2)%z, var3%R(2)%D(2,2)%z)
+deallocate(var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D)
+
+deallocate(var4%R(3)%C%x, var4%R(3)%D(1,1)%x, var4%R(3)%D(2,1)%x, var4%R(3)%D(1,2)%x, var4%R(3)%D(2,2)%x)
+deallocate(var4%R(3)%C%y, var4%R(3)%D(1,1)%y, var4%R(3)%D(2,1)%y, var4%R(3)%D(1,2)%y, var4%R(3)%D(2,2)%y)
+deallocate(var4%R(3)%C%z, var4%R(3)%D(1,1)%z, var4%R(3)%D(2,1)%z, var4%R(3)%D(1,2)%z, var4%R(3)%D(2,2)%z)
+deallocate(var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+
+ print *, "valid mapping, OK"
+endif
+
+contains
+ subroutine foo(x, y)
+ type(t) :: x, y
+ intent(in) :: x
+ intent(inout) :: y
+ integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+ if (x%A /= 45) stop 1
+ if (any (x%B /= [1,2,3])) stop 2
+ if (x%C%x /= 6) stop 3
+ if (x%C%y /= 5) stop 3
+ if (x%C%z /= 4) stop 3
+
+ tmp_x = reshape([1, 4, 11, 14], [2,2])
+ tmp_y = reshape([2, 5, 12, 15], [2,2])
+ tmp_z = reshape([3, 6, 13, 16], [2,2])
+ do j = 1, 2
+ do i = 1, 2
+ if (x%D(i,j)%x /= tmp_x(i,j)) stop 4
+ if (x%D(i,j)%y /= tmp_y(i,j)) stop 4
+ if (x%D(i,j)%z /= tmp_z(i,j)) stop 4
+ end do
+ end do
+
+ if (y%A /= 145) stop 5
+ if (any (y%B /= [991,992,993])) stop 6
+ if (y%C%x /= 996) stop 7
+ if (y%C%y /= 995) stop 7
+ if (y%C%z /= 994) stop 7
+ tmp_x = reshape([199, 499, 1199, 1499], [2,2])
+ tmp_y = reshape([299, 599, 1299, 1599], [2,2])
+ tmp_z = reshape([399, 699, 1399, 1699], [2,2])
+ do j = 1, 2
+ do i = 1, 2
+ if (y%D(i,j)%x /= tmp_x(i,j)) stop 8
+ if (y%D(i,j)%y /= tmp_y(i,j)) stop 8
+ if (y%D(i,j)%z /= tmp_z(i,j)) stop 8
+ end do
+ end do
+
+ y%A = x%A
+ y%B(:) = x%B
+ y%C%x = x%C%x
+ y%C%y = x%C%y
+ y%C%z = x%C%z
+ do j = 1, 2
+ do i = 1, 2
+ y%D(i,j)%x = x%D(i,j)%x
+ y%D(i,j)%y = x%D(i,j)%y
+ y%D(i,j)%z = x%D(i,j)%z
+ end do
+ end do
+ end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
new file mode 100644
index 0000000..1493c5f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
@@ -0,0 +1,672 @@
+module m
+ implicit none (type, external)
+ type t
+ integer, allocatable :: arr(:,:)
+ integer :: var
+ integer, allocatable :: slr
+ end type t
+
+contains
+
+ subroutine check_it (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ type(t), intent(inout) :: &
+ scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
+ a_opt_scalar, a_opt_array(:,:), &
+ l_scalar, l_array(:,:), la_scalar, la_array(:,:)
+ optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+ allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+ logical, value :: is_present, dummy_alloced, inner_alloc
+ integer :: i, j, k, l
+
+ ! CHECK VALUE
+ if (scalar%var /= 42) stop 1
+ if (l_scalar%var /= 42) stop 1
+ if (is_present) then
+ if (opt_scalar%var /= 42) stop 2
+ end if
+ if (any (shape(array) /= [3,2])) stop 1
+ if (any (shape(l_array) /= [3,2])) stop 1
+ if (is_present) then
+ if (any (shape(opt_array) /= [3,2])) stop 1
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (array(i,j)%var /= i*97 + 100*41*j) stop 3
+ if (l_array(i,j)%var /= i*97 + 100*41*j) stop 3
+ if (is_present) then
+ if (opt_array(i,j)%var /= i*97 + 100*41*j) stop 4
+ end if
+ end do
+ end do
+
+ if (dummy_alloced) then
+ if (a_scalar%var /= 42) stop 1
+ if (la_scalar%var /= 42) stop 1
+ if (is_present) then
+ if (a_opt_scalar%var /= 42) stop 1
+ end if
+ if (any (shape(a_array) /= [3,2])) stop 1
+ if (any (shape(la_array) /= [3,2])) stop 1
+ if (is_present) then
+ if (any (shape(a_opt_array) /= [3,2])) stop 1
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (a_array(i,j)%var /= i*97 + 100*41*j) stop 1
+ if (la_array(i,j)%var /= i*97 + 100*41*j) stop 1
+ if (is_present) then
+ if (a_opt_array(i,j)%var /= i*97 + 100*41*j) stop 1
+ end if
+ end do
+ end do
+ else
+ if (allocated (a_scalar)) stop 1
+ if (allocated (la_scalar)) stop 1
+ if (allocated (a_array)) stop 1
+ if (allocated (la_array)) stop 1
+ if (is_present) then
+ if (allocated (a_opt_scalar)) stop 1
+ if (allocated (a_opt_array)) stop 1
+ end if
+ end if
+
+ if (inner_alloc) then
+ if (scalar%slr /= 467) stop 5
+ if (l_scalar%slr /= 467) stop 5
+ if (a_scalar%slr /= 467) stop 6
+ if (la_scalar%slr /= 467) stop 6
+ if (is_present) then
+ if (opt_scalar%slr /= 467) stop 7
+ if (a_opt_scalar%slr /= 467) stop 8
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 9
+ if (l_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 9
+ if (a_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 10
+ if (la_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 10
+ if (is_present) then
+ if (opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 11
+ if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 12
+ end if
+ end do
+ end do
+
+ do l = 1, 5
+ do k = 1, 4
+ if (any (shape(scalar%arr) /= [4,5])) stop 1
+ if (any (shape(l_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(a_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(la_scalar%arr) /= [4,5])) stop 1
+ if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
+ if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
+ if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
+ if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
+ if (is_present) then
+ if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
+ if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 15
+ if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 16
+ end if
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
+ if (is_present) then
+ if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
+ endif
+ do l = 1, j
+ do k = 1, i
+ if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
+ if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
+ if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
+ if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
+ if (is_present) then
+ if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 19
+ if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 20
+ end if
+ end do
+ end do
+ end do
+ end do
+ else if (dummy_alloced) then
+ if (allocated (scalar%slr)) stop 1
+ if (allocated (l_scalar%slr)) stop 1
+ if (allocated (a_scalar%slr)) stop 1
+ if (allocated (la_scalar%slr)) stop 1
+ if (is_present) then
+ if (allocated (opt_scalar%slr)) stop 1
+ if (allocated (a_opt_scalar%slr)) stop 1
+ endif
+ if (allocated (scalar%arr)) stop 1
+ if (allocated (l_scalar%arr)) stop 1
+ if (allocated (a_scalar%arr)) stop 1
+ if (allocated (la_scalar%arr)) stop 1
+ if (is_present) then
+ if (allocated (opt_scalar%arr)) stop 1
+ if (allocated (a_opt_scalar%arr)) stop 1
+ endif
+ end if
+
+ ! SET VALUE
+ scalar%var = 42 + 13
+ l_scalar%var = 42 + 13
+ if (is_present) then
+ opt_scalar%var = 42 + 13
+ endif
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%var = i*97 + 100*41*j + 13
+ l_array(i,j)%var = i*97 + 100*41*j + 13
+ if (is_present) then
+ opt_array(i,j)%var = i*97 + 100*41*j + 13
+ end if
+ end do
+ end do
+
+ if (dummy_alloced) then
+ a_scalar%var = 42 + 13
+ la_scalar%var = 42 + 13
+ if (is_present) then
+ a_opt_scalar%var = 42 + 13
+ endif
+ do j = 1, 2
+ do i = 1, 3
+ a_array(i,j)%var = i*97 + 100*41*j + 13
+ la_array(i,j)%var = i*97 + 100*41*j + 13
+ if (is_present) then
+ a_opt_array(i,j)%var = i*97 + 100*41*j + 13
+ endif
+ end do
+ end do
+ end if
+
+ if (inner_alloc) then
+ scalar%slr = 467 + 13
+ l_scalar%slr = 467 + 13
+ a_scalar%slr = 467 + 13
+ la_scalar%slr = 467 + 13
+ if (is_present) then
+ opt_scalar%slr = 467 + 13
+ a_opt_scalar%slr = 467 + 13
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ l_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ a_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ la_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ if (is_present) then
+ opt_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
+ end if
+ end do
+ end do
+
+ do l = 1, 5
+ do k = 1, 4
+ scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ if (is_present) then
+ opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+ end if
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ do l = 1, j
+ do k = 1, i
+ array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ if (is_present) then
+ opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+ end if
+ end do
+ end do
+ end do
+ end do
+ end if
+
+ end subroutine
+ subroutine check_reset (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ type(t), intent(inout) :: &
+ scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
+ a_opt_scalar, a_opt_array(:,:), &
+ l_scalar, l_array(:,:), la_scalar, la_array(:,:)
+ optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+ allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+ logical, value :: is_present, dummy_alloced, inner_alloc
+ integer :: i, j, k, l
+
+ ! CHECK VALUE
+ if (scalar%var /= 42 + 13) stop 1
+ if (l_scalar%var /= 42 + 13) stop 1
+ if (is_present) then
+ if (opt_scalar%var /= 42 + 13) stop 2
+ end if
+ if (any (shape(array) /= [3,2])) stop 1
+ if (any (shape(l_array) /= [3,2])) stop 1
+ if (is_present) then
+ if (any (shape(opt_array) /= [3,2])) stop 1
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
+ if (l_array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
+ if (is_present) then
+ if (opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 4
+ end if
+ end do
+ end do
+
+ if (dummy_alloced) then
+ if (a_scalar%var /= 42 + 13) stop 1
+ if (la_scalar%var /= 42 + 13) stop 1
+ if (is_present) then
+ if (a_opt_scalar%var /= 42 + 13) stop 1
+ end if
+ if (any (shape(a_array) /= [3,2])) stop 1
+ if (any (shape(la_array) /= [3,2])) stop 1
+ if (is_present) then
+ if (any (shape(a_opt_array) /= [3,2])) stop 1
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (a_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+ if (la_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+ if (is_present) then
+ if (a_opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+ end if
+ end do
+ end do
+ else
+ if (allocated (a_scalar)) stop 1
+ if (allocated (la_scalar)) stop 1
+ if (allocated (a_array)) stop 1
+ if (allocated (la_array)) stop 1
+ if (is_present) then
+ if (allocated (a_opt_scalar)) stop 1
+ if (allocated (a_opt_array)) stop 1
+ end if
+ end if
+
+ if (inner_alloc) then
+ if (scalar%slr /= 467 + 13) stop 5
+ if (l_scalar%slr /= 467 + 13) stop 5
+ if (a_scalar%slr /= 467 + 13) stop 6
+ if (la_scalar%slr /= 467 + 13) stop 6
+ if (is_present) then
+ if (opt_scalar%slr /= 467 + 13) stop 7
+ if (a_opt_scalar%slr /= 467 + 13) stop 8
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ if (array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 9
+ if (l_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 9
+ if (a_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 10
+ if (la_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 10
+ if (is_present) then
+ if (opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 11
+ if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 12
+ end if
+ end do
+ end do
+
+ do l = 1, 5
+ do k = 1, 4
+ if (any (shape(scalar%arr) /= [4,5])) stop 1
+ if (any (shape(l_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(a_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(la_scalar%arr) /= [4,5])) stop 1
+ if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
+ if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
+ if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
+ if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
+ if (is_present) then
+ if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
+ if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
+ if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 15
+ if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 16
+ end if
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
+ if (is_present) then
+ if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
+ if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
+ endif
+ do l = 1, j
+ do k = 1, i
+ if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
+ if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
+ if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
+ if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
+ if (is_present) then
+ if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 19
+ if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 20
+ end if
+ end do
+ end do
+ end do
+ end do
+ else if (dummy_alloced) then
+ if (allocated (scalar%slr)) stop 1
+ if (allocated (l_scalar%slr)) stop 1
+ if (allocated (a_scalar%slr)) stop 1
+ if (allocated (la_scalar%slr)) stop 1
+ if (is_present) then
+ if (allocated (opt_scalar%slr)) stop 1
+ if (allocated (a_opt_scalar%slr)) stop 1
+ endif
+ if (allocated (scalar%arr)) stop 1
+ if (allocated (l_scalar%arr)) stop 1
+ if (allocated (a_scalar%arr)) stop 1
+ if (allocated (la_scalar%arr)) stop 1
+ if (is_present) then
+ if (allocated (opt_scalar%arr)) stop 1
+ if (allocated (a_opt_scalar%arr)) stop 1
+ endif
+ end if
+
+ ! (RE)SET VALUE
+ scalar%var = 42
+ l_scalar%var = 42
+ if (is_present) then
+ opt_scalar%var = 42
+ endif
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%var = i*97 + 100*41*j
+ l_array(i,j)%var = i*97 + 100*41*j
+ if (is_present) then
+ opt_array(i,j)%var = i*97 + 100*41*j
+ end if
+ end do
+ end do
+
+ if (dummy_alloced) then
+ a_scalar%var = 42
+ la_scalar%var = 42
+ if (is_present) then
+ a_opt_scalar%var = 42
+ endif
+ do j = 1, 2
+ do i = 1, 3
+ a_array(i,j)%var = i*97 + 100*41*j
+ la_array(i,j)%var = i*97 + 100*41*j
+ if (is_present) then
+ a_opt_array(i,j)%var = i*97 + 100*41*j
+ endif
+ end do
+ end do
+ end if
+
+ if (inner_alloc) then
+ scalar%slr = 467
+ l_scalar%slr = 467
+ a_scalar%slr = 467
+ la_scalar%slr = 467
+ if (is_present) then
+ opt_scalar%slr = 467
+ a_opt_scalar%slr = 467
+ end if
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%slr = (i*97 + 100*41*j) + 467
+ l_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ a_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ la_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ if (is_present) then
+ opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ end if
+ end do
+ end do
+
+ do l = 1, 5
+ do k = 1, 4
+ scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ if (is_present) then
+ opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ end if
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ do l = 1, j
+ do k = 1, i
+ array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ if (is_present) then
+ opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ end if
+ end do
+ end do
+ end do
+ end do
+ end if
+ end subroutine
+
+ subroutine test(scalar, array, a_scalar, a_array, opt_scalar, opt_array, &
+ a_opt_scalar, a_opt_array)
+ type(t) :: scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:)
+ type(t) :: a_opt_scalar, a_opt_array(:,:)
+ type(t) :: l_scalar, l_array(3,2), la_scalar, la_array(:,:)
+ allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+ optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+
+ integer :: i, j, k, l
+ logical :: is_present, dummy_alloced, local_alloced, inner_alloc
+ is_present = present(opt_scalar)
+ dummy_alloced = allocated(a_scalar)
+ inner_alloc = allocated(scalar%slr)
+
+ l_scalar%var = 42
+ do j = 1, 2
+ do i = 1, 3
+ l_array(i,j)%var = i*97 + 100*41*j
+ end do
+ end do
+
+ if (dummy_alloced) then
+ allocate(la_scalar, la_array(3,2))
+ a_scalar%var = 42
+ la_scalar%var = 42
+ do j = 1, 2
+ do i = 1, 3
+ l_array(i,j)%var = i*97 + 100*41*j
+ la_array(i,j)%var = i*97 + 100*41*j
+ end do
+ end do
+ end if
+
+ if (inner_alloc) then
+ l_scalar%slr = 467
+ la_scalar%slr = 467
+ do j = 1, 2
+ do i = 1, 3
+ l_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ la_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ end do
+ end do
+
+ allocate(l_scalar%arr(4,5), la_scalar%arr(4,5))
+ do l = 1, 5
+ do k = 1, 4
+ l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ allocate(l_array(i,j)%arr(i,j), la_array(i,j)%arr(i,j))
+ do l = 1, j
+ do k = 1, i
+ l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ end do
+ end do
+ end do
+ end do
+ end if
+
+ ! implicit mapping
+ !$omp target
+ if (is_present) then
+ call check_it (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ else
+ call check_it (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array)
+ end if
+ !$omp end target
+
+ if (is_present) then
+ call check_reset (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ else
+ call check_reset (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array)
+ endif
+
+ ! explicit mapping
+ !$omp target map(scalar, array, opt_scalar, opt_array, a_scalar, a_array) &
+ !$omp& map(a_opt_scalar, a_opt_array) &
+ !$omp& map(l_scalar, l_array, la_scalar, la_array)
+ if (is_present) then
+ call check_it (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ else
+ call check_it (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array)
+ endif
+ !$omp end target
+
+ if (is_present) then
+ call check_reset (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array, &
+ opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+ else
+ call check_reset (is_present, dummy_alloced, inner_alloc, &
+ scalar, array, a_scalar, a_array, &
+ l_scalar, l_array, la_scalar, la_array)
+ endif
+ end subroutine
+end module
+
+program main
+ use m
+ implicit none (type, external)
+ type(t) :: scalar, array(3,2), opt_scalar, opt_array(3,2), a_scalar, a_array(:,:)
+ type(t) :: a_opt_scalar, a_opt_array(:,:)
+ allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array
+ integer :: i, j, k, l, n
+
+ scalar%var = 42
+ opt_scalar%var = 42
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%var = i*97 + 100*41*j
+ opt_array(i,j)%var = i*97 + 100*41*j
+ end do
+ end do
+
+ ! unallocated
+ call test (scalar, array, a_scalar, a_array)
+ call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+ ! allocated
+ allocate(a_scalar, a_opt_scalar, a_array(3,2), a_opt_array(3,2))
+ a_scalar%var = 42
+ a_opt_scalar%var = 42
+ do j = 1, 2
+ do i = 1, 3
+ a_array(i,j)%var = i*97 + 100*41*j
+ a_opt_array(i,j)%var = i*97 + 100*41*j
+ end do
+ end do
+
+ call test (scalar, array, a_scalar, a_array)
+ call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+ ! comps allocated
+ scalar%slr = 467
+ a_scalar%slr = 467
+ opt_scalar%slr = 467
+ a_opt_scalar%slr = 467
+ do j = 1, 2
+ do i = 1, 3
+ array(i,j)%slr = (i*97 + 100*41*j) + 467
+ a_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
+ end do
+ end do
+
+ allocate(scalar%arr(4,5), a_scalar%arr(4,5), opt_scalar%arr(4,5), a_opt_scalar%arr(4,5))
+ do l = 1, 5
+ do k = 1, 4
+ scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+ end do
+ end do
+ do j = 1, 2
+ do i = 1, 3
+ allocate(array(i,j)%arr(i,j), a_array(i,j)%arr(i,j), opt_array(i,j)%arr(i,j), a_opt_array(i,j)%arr(i,j))
+ do l = 1, j
+ do k = 1, i
+ array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+ end do
+ end do
+ end do
+ end do
+
+ call test (scalar, array, a_scalar, a_array)
+ call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+ deallocate(a_scalar, a_opt_scalar, a_array, a_opt_array)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
new file mode 100644
index 0000000..f5a286e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
@@ -0,0 +1,268 @@
+module m
+ implicit none (type, external)
+ type t
+ integer, allocatable :: A(:)
+ end type t
+ type t2
+ type(t), allocatable :: vT
+ integer, allocatable :: x
+ end type t2
+
+contains
+
+ subroutine test_alloc()
+ type(t) :: var
+ type(t), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%A(4), var2%A(5))
+
+ !$omp target enter data map(alloc: var, var2)
+ !$omp target
+ if (.not. allocated(Var2)) stop 1
+ if (.not. allocated(Var%A)) stop 2
+ if (.not. allocated(Var2%A)) stop 3
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+ var%A = [1,2,3,4]
+ var2%A = [11,22,33,44,55]
+ !$omp end target
+ !$omp target exit data map(from: var, var2)
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%A)) error stop
+ if (.not. allocated(Var2%A)) error stop
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+ if (any(var%A /= [1,2,3,4])) error stop
+ if (any(var2%A /= [11,22,33,44,55])) error stop
+ end subroutine test_alloc
+
+ subroutine test2_alloc()
+ type(t2) :: var
+ type(t2), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%x, var2%x)
+
+ !$omp target enter data map(alloc: var, var2)
+ !$omp target
+ if (.not. allocated(Var2)) stop 6
+ if (.not. allocated(Var%x)) stop 7
+ if (.not. allocated(Var2%x)) stop 8
+ var%x = 42
+ var2%x = 43
+ !$omp end target
+ !$omp target exit data map(from: var, var2)
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+ if (var%x /= 42) error stop
+ if (var2%x /= 43) error stop
+
+ allocate(var%vt, var2%vt)
+ allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+ !$omp target enter data map(alloc: var, var2)
+ !$omp target
+ if (.not. allocated(Var2)) stop 11
+ if (.not. allocated(Var%x)) stop 12
+ if (.not. allocated(Var2%x)) stop 13
+ if (.not. allocated(Var%vt)) stop 14
+ if (.not. allocated(Var2%vt)) stop 15
+ if (.not. allocated(Var%vt%a)) stop 16
+ if (.not. allocated(Var2%vt%a)) stop 17
+ var%x = 42
+ var2%x = 43
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+ var%vt%A = [1,2,3,4,5]
+ var2%vt%A = [11,22,33,44,55]
+ !$omp end target
+ !$omp target exit data map(from: var, var2)
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+ if (.not. allocated(Var%vt)) error stop
+ if (.not. allocated(Var2%vt)) error stop
+ if (.not. allocated(Var%vt%a)) error stop
+ if (.not. allocated(Var2%vt%a)) error stop
+ if (var%x /= 42) error stop
+ if (var2%x /= 43) error stop
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+ if (any(var%vt%A /= [1,2,3,4,5])) error stop
+ if (any(var2%vt%A /= [11,22,33,44,55])) error stop
+ end subroutine test2_alloc
+
+
+ subroutine test_alloc_target()
+ type(t) :: var
+ type(t), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%A(4), var2%A(5))
+
+ !$omp target map(alloc: var, var2)
+ if (.not. allocated(Var2)) stop 1
+ if (.not. allocated(Var%A)) stop 2
+ if (.not. allocated(Var2%A)) stop 3
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+ var%A = [1,2,3,4]
+ var2%A = [11,22,33,44,55]
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%A)) error stop
+ if (.not. allocated(Var2%A)) error stop
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+ end subroutine test_alloc_target
+
+ subroutine test2_alloc_target()
+ type(t2) :: var
+ type(t2), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%x, var2%x)
+
+ !$omp target map(alloc: var, var2)
+ if (.not. allocated(Var2)) stop 6
+ if (.not. allocated(Var%x)) stop 7
+ if (.not. allocated(Var2%x)) stop 8
+ var%x = 42
+ var2%x = 43
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+
+ allocate(var%vt, var2%vt)
+ allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+ !$omp target map(alloc: var, var2)
+ if (.not. allocated(Var2)) stop 11
+ if (.not. allocated(Var%x)) stop 12
+ if (.not. allocated(Var2%x)) stop 13
+ if (.not. allocated(Var%vt)) stop 14
+ if (.not. allocated(Var2%vt)) stop 15
+ if (.not. allocated(Var%vt%a)) stop 16
+ if (.not. allocated(Var2%vt%a)) stop 17
+ var%x = 42
+ var2%x = 43
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+ var%vt%A = [1,2,3,4,5]
+ var2%vt%A = [11,22,33,44,55]
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+ if (.not. allocated(Var%vt)) error stop
+ if (.not. allocated(Var2%vt)) error stop
+ if (.not. allocated(Var%vt%a)) error stop
+ if (.not. allocated(Var2%vt%a)) error stop
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+ end subroutine test2_alloc_target
+
+
+
+ subroutine test_from()
+ type(t) :: var
+ type(t), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%A(4), var2%A(5))
+
+ !$omp target map(from: var, var2)
+ if (.not. allocated(Var2)) stop 1
+ if (.not. allocated(Var%A)) stop 2
+ if (.not. allocated(Var2%A)) stop 3
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+ var%A = [1,2,3,4]
+ var2%A = [11,22,33,44,55]
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%A)) error stop
+ if (.not. allocated(Var2%A)) error stop
+ if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+ if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+ if (any(var%A /= [1,2,3,4])) error stop
+ if (any(var2%A /= [11,22,33,44,55])) error stop
+ end subroutine test_from
+
+ subroutine test2_from()
+ type(t2) :: var
+ type(t2), allocatable :: var2
+
+ allocate(var2)
+ allocate(var%x, var2%x)
+
+ !$omp target map(from: var, var2)
+ if (.not. allocated(Var2)) stop 6
+ if (.not. allocated(Var%x)) stop 7
+ if (.not. allocated(Var2%x)) stop 8
+ var%x = 42
+ var2%x = 43
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+ if (var%x /= 42) error stop
+ if (var2%x /= 43) error stop
+
+ allocate(var%vt, var2%vt)
+ allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+ !$omp target map(from: var, var2)
+ if (.not. allocated(Var2)) stop 11
+ if (.not. allocated(Var%x)) stop 12
+ if (.not. allocated(Var2%x)) stop 13
+ if (.not. allocated(Var%vt)) stop 14
+ if (.not. allocated(Var2%vt)) stop 15
+ if (.not. allocated(Var%vt%a)) stop 16
+ if (.not. allocated(Var2%vt%a)) stop 17
+ var%x = 42
+ var2%x = 43
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+ var%vt%A = [1,2,3,4,5]
+ var2%vt%A = [11,22,33,44,55]
+ !$omp end target
+
+ if (.not. allocated(Var2)) error stop
+ if (.not. allocated(Var%x)) error stop
+ if (.not. allocated(Var2%x)) error stop
+ if (.not. allocated(Var%vt)) error stop
+ if (.not. allocated(Var2%vt)) error stop
+ if (.not. allocated(Var%vt%a)) error stop
+ if (.not. allocated(Var2%vt%a)) error stop
+ if (var%x /= 42) error stop
+ if (var2%x /= 43) error stop
+ if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+ if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+ if (any(var%vt%A /= [1,2,3,4,5])) error stop
+ if (any(var2%vt%A /= [11,22,33,44,55])) error stop
+ end subroutine test2_from
+
+end module m
+
+use m
+ implicit none (type, external)
+ call test_alloc
+ call test2_alloc
+ call test_alloc_target
+ call test2_alloc_target
+
+ call test_from
+ call test2_from
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
new file mode 100644
index 0000000..3cec392
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
@@ -0,0 +1,559 @@
+! Ensure that polymorphic mapping is diagnosed as undefined behavior
+! Ensure that static access to polymorphic variables works
+
+subroutine test(case)
+implicit none(type, external)
+type t
+ integer :: x(4)
+end type t
+
+type ta
+ integer, allocatable :: x(:)
+end type ta
+
+type t2
+ class(t), allocatable :: x
+ class(t), allocatable :: x2(:)
+end type t2
+
+type t3
+ type(t2) :: y
+ type(t2) :: y2(2)
+end type t3
+
+type t4
+ type(t3), allocatable :: y
+ type(t3), allocatable :: y2(:)
+end type t4
+
+integer, value :: case
+
+logical :: is_shared_mem
+
+! Mangle stack addresses
+integer, volatile :: case_var(100*case)
+
+type(t), allocatable :: var1
+type(ta), allocatable :: var1a
+class(t), allocatable :: var2
+type(t2), allocatable :: var3
+type(t4), allocatable :: var4
+
+case_var(100) = 0
+!print *, 'case', case
+
+var1 = t([1,2,3,4])
+var1a = ta([-1,-2,-3,-4,-5])
+
+var2 = t([11,22,33,44])
+
+allocate(t2 :: var3)
+allocate(t :: var3%x)
+allocate(t :: var3%x2(2))
+var3%x%x = [111,222,333,444]
+var3%x2(1)%x = 2*[111,222,333,444]
+var3%x2(2)%x = 3*[111,222,333,444]
+
+allocate(t4 :: var4)
+allocate(t3 :: var4%y)
+allocate(t3 :: var4%y2(2))
+allocate(t :: var4%y%y%x)
+allocate(t :: var4%y%y%x2(2))
+allocate(t :: var4%y2(1)%y%x)
+allocate(t :: var4%y2(1)%y%x2(2))
+allocate(t :: var4%y2(2)%y%x)
+allocate(t :: var4%y2(2)%y%x2(2))
+var4%y%y%x%x = -1 * [1111,2222,3333,4444]
+var4%y%y%x2(1)%x = -2 * [1111,2222,3333,4444]
+var4%y%y%x2(2)%x = -3 * [1111,2222,3333,4444]
+var4%y2(1)%y%x%x = -4 * [1111,2222,3333,4444]
+var4%y2(1)%y%x2(1)%x = -5 * [1111,2222,3333,4444]
+var4%y2(1)%y%x2(2)%x = -6 * [1111,2222,3333,4444]
+var4%y2(2)%y%x%x = -7 * [1111,2222,3333,4444]
+var4%y2(2)%y%x2(1)%x = -8 * [1111,2222,3333,4444]
+var4%y2(2)%y%x2(2)%x = -9 * [1111,2222,3333,4444]
+
+is_shared_mem = .false.
+!$omp target map(to: is_shared_mem)
+ is_shared_mem = .true.
+!$omp end target
+
+if (case == 1) then
+ ! implicit mapping
+ !$omp target
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ end if
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ end if
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+else if (case == 2) then
+ ! Use target with defaultmap(TO)
+
+ !$omp target defaultmap(to : all)
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target defaultmap(to : all)
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target defaultmap(to : all) ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target defaultmap(to : all) ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target defaultmap(to : all) firstprivate(is_shared_mem) ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ endif
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+else if (case == 3) then
+ ! Use target with map clause
+
+ !$omp target map(tofrom: var1)
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target map(tofrom: var1a)
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target map(tofrom: var2) ! { dg-warning "28: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target map(tofrom: var3) ! { dg-warning "28: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target map(tofrom: var4) ! { dg-warning "28: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ end if
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ endif
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+else if (case == 4) then
+ ! Use target with map clause -- NOTE: This uses TO not TOFROM
+
+ !$omp target map(to: var1)
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target map(to: var1a)
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target map(to: var2) ! { dg-warning "24: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target map(to: var3) ! { dg-warning "24: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target map(to: var4) ! { dg-warning "24: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ endif
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+else if (case == 5) then
+ ! Use target enter/exit data + target with explicit map
+ !$omp target enter data map(to: var1)
+ !$omp target enter data map(to: var1a)
+ !$omp target enter data map(to: var2) ! { dg-warning "35: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target enter data map(to: var3) ! { dg-warning "35: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target enter data map(to: var4) ! { dg-warning "35: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+ !$omp target map(to: var1)
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target map(to: var1a)
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target map(to: var2) ! { dg-warning "24: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target map(to: var3) ! { dg-warning "24: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target map(to: var4) ! { dg-warning "24: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ endif
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target exit data map(from: var1)
+ !$omp target exit data map(from: var1a)
+ !$omp target exit data map(from: var2) ! { dg-warning "36: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target exit data map(from: var3) ! { dg-warning "36: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target exit data map(from: var4) ! { dg-warning "36: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+else if (case == 6) then
+ ! Use target enter/exit data + target with implicit map
+
+ !$omp target enter data map(to: var1)
+ !$omp target enter data map(to: var1a)
+ !$omp target enter data map(to: var2) ! { dg-warning "35: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target enter data map(to: var3) ! { dg-warning "35: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target enter data map(to: var4) ! { dg-warning "35: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+ !$omp target
+ if (any (var1%x /= [1,2,3,4])) stop 1
+ var1%x = 2 * var1%x
+ !$omp end target
+
+ !$omp target
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+ var1a%x = 3 * var1a%x
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var2%x /= [11,22,33,44])) stop 3
+ var2%x = 4 * var2%x
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var3%x%x /= [111,222,333,444])) stop 4
+ var3%x%x = 5 * var3%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+ if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+ var3%x2(1)%x = 5 * var3%x2(1)%x
+ var3%x2(2)%x = 5 * var3%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+ endif
+ var4%y%y%x%x = 6 * var4%y%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+ var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+ endif
+ var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+ var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+ endif
+ var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+ var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+ endif
+ !$omp end target
+
+ !$omp target exit data map(from: var1)
+ !$omp target exit data map(from: var1a)
+ !$omp target exit data map(from: var2) ! { dg-warning "36: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target exit data map(from: var3) ! { dg-warning "36: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+ !$omp target exit data map(from: var4) ! { dg-warning "36: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+else
+ error stop
+end if
+
+if ((case /= 2 .and. case /= 4) .or. is_shared_mem) then
+ ! The target update should have been active, check for the updated values
+ if (any (var1%x /= 2 * [1,2,3,4])) stop 11
+ if (any (var1a%x /= 3 * [-1,-2,-3,-4])) stop 22
+ if (any (var2%x /= 4 * [11,22,33,44])) stop 33
+
+ if (any (var3%x%x /= 5 * [111,222,333,444])) stop 44
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var3%x2(1)%x /= 2 * 5 * [111,222,333,444])) stop 44
+ if (any (var3%x2(2)%x /= 3 * 5 * [111,222,333,444])) stop 44
+ endif
+
+ if (any (var4%y%y%x%x /= -1 * 6 * [1111,2222,3333,4444])) stop 55
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y%y%x2(1)%x /= -2 * 6 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y%y%x2(2)%x /= -3 * 6 * [1111,2222,3333,4444])) stop 55
+ endif
+ if (any (var4%y2(1)%y%x%x /= -4 * 6 * [1111,2222,3333,4444])) stop 55
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(1)%y%x2(1)%x /= -5 * 6 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y2(1)%y%x2(2)%x /= -6 * 6 * [1111,2222,3333,4444])) stop 55
+ endif
+ if (any (var4%y2(2)%y%x%x /= -7 * 6 * [1111,2222,3333,4444])) stop 55
+ if (is_shared_mem) then ! For stride data, this accesses the host's _vtab
+ if (any (var4%y2(2)%y%x2(1)%x /= -8 * 6 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y2(2)%y%x2(2)%x /= -9 * 6 * [1111,2222,3333,4444])) stop 55
+ endif
+else
+ ! The old host values should still be there as 'to:' created a device copy
+ if (any (var1%x /= [1,2,3,4])) stop 12
+ if (any (var1a%x /= [-1,-2,-3,-4])) stop 22
+ if (any (var2%x /= [11,22,33,44])) stop 33
+
+ if (any (var3%x%x /= [111,222,333,444])) stop 44
+ ! .not. is_shared_mem:
+ ! if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 44
+ ! if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 44
+
+ if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 55
+ ! .not. is_shared_mem:
+ !if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 55
+ !if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 55
+ if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 55
+ ! .not. is_shared_mem:
+ !if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 55
+ !if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 55
+end if
+if (case_var(100) /= 0) stop 123
+end subroutine test
+
+program main
+ use omp_lib
+ implicit none(type, external)
+ interface
+ subroutine test(case)
+ integer, value :: case
+ end
+ end interface
+ integer :: dev
+ call run_it(omp_get_default_device())
+ do dev = 0, omp_get_num_devices()
+ call run_it(dev)
+ end do
+ call run_it(omp_initial_device)
+! print *, 'all done'
+contains
+subroutine run_it(dev)
+ integer, value :: dev
+! print *, 'DEVICE', dev
+ call omp_set_default_device(dev)
+ call test(1)
+ call test(2)
+ call test(3)
+ call test(4)
+ call test(5)
+ call test(6)
+end
+end
generated by cgit v1.1 at 2025-04-22 14:16:17 +0000