mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
6629444170
OpenMP 5.0 permits to use arrays with derived type components for the list items to the 'from'/'to' clauses of the 'target update' directive. gcc/fortran/ChangeLog: * openmp.cc (gfc_match_omp_clauses): Permit derived types for the 'to' and 'from' clauses of 'target update'. * trans-openmp.cc (gfc_trans_omp_clauses): Fixes for derived-type changes; fix size for scalars. libgomp/ChangeLog: * testsuite/libgomp.fortran/target-11.f90: New test. * testsuite/libgomp.fortran/target-13.f90: New test.
160 lines
4.4 KiB
Fortran
160 lines
4.4 KiB
Fortran
module m
|
|
implicit none
|
|
type t
|
|
integer :: s, a(5)
|
|
end type t
|
|
|
|
type t2
|
|
integer :: s, a(5)
|
|
type(t) :: st, at(2:3)
|
|
end type t2
|
|
|
|
interface operator(/=)
|
|
procedure ne_compare_t
|
|
procedure ne_compare_t2
|
|
end interface
|
|
|
|
contains
|
|
|
|
logical pure elemental function ne_compare_t (a, b) result(res)
|
|
type(t), intent(in) :: a, b
|
|
res = (a%s /= b%s) .or. any(a%a /= b%a)
|
|
end function
|
|
|
|
logical pure elemental function ne_compare_t2 (a, b) result(res)
|
|
type(t2), intent(in) :: a, b
|
|
res = (a%s /= b%s) .or. any(a%a /= b%a) &
|
|
.or. (a%st /= b%st) .or. any(a%at /= b%at)
|
|
end function
|
|
end module m
|
|
|
|
program p
|
|
use m
|
|
implicit none
|
|
|
|
type(t2) :: var1, var2(5), var3(:)
|
|
type(t2) :: var1a, var2a(5), var3a(:)
|
|
allocatable :: var3, var3a
|
|
logical :: shared_memory = .false.
|
|
|
|
!$omp target map(to: shared_memory)
|
|
shared_memory = .true.
|
|
!$omp end target
|
|
|
|
var1 = T2(1, [1,2,3,4,5], T(11, [11,22,33,44,55]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])
|
|
|
|
var2 = [T2(101, [201,202,203,204,205], T(2011, [2011,2022,2033,2044,2055]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(111, [211,212,213,214,215], T(2111, [2111,2122,2133,2144,2155]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(121, [221,222,223,224,225], T(2211, [2211,2222,2233,2244,2255]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(131, [231,232,233,234,235], T(2311, [2311,2322,2333,2344,2355]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(141, [241,242,243,244,245], T(2411, [2411,2422,2433,2444,2455]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
|
|
|
|
var3 = [T2(301, [401,402,403,404,405], T(4011, [4011,4022,4033,4044,4055]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(311, [411,412,413,414,415], T(4111, [4111,4122,4133,4144,4155]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(321, [421,422,423,424,425], T(4211, [4211,4222,4233,4244,4255]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(331, [431,432,433,434,435], T(4311, [4311,4322,4333,4344,4355]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
|
T2(341, [441,442,443,444,445], T(4411, [4411,4422,4433,4444,4455]), &
|
|
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
|
|
|
|
var1a = var1
|
|
var2a = var2
|
|
var3a = var3
|
|
|
|
!$omp target enter data map(to:var1)
|
|
!$omp target enter data map(to:var2)
|
|
!$omp target enter data map(to:var3)
|
|
|
|
! ---------------
|
|
|
|
!$omp target update from(var1%at(2:3))
|
|
|
|
if (var1a /= var1) error stop
|
|
if (any (var2a /= var2)) error stop
|
|
if (any (var3a /= var3)) error stop
|
|
|
|
! ---------------
|
|
|
|
!$omp target
|
|
var1%st%s = 1243
|
|
var2(3)%at(2) = T(123, [345,64,356,39,13])
|
|
var2(3)%at(3) = T(48, [74,162,572,357,3])
|
|
!$omp end target
|
|
|
|
if (.not. shared_memory) then
|
|
if (var1 /= var1) error stop
|
|
if (any (var2a /= var2)) error stop
|
|
if (any (var3a /= var3)) error stop
|
|
endif
|
|
|
|
!$omp target update from(var1%st) from(var2(3)%at(2:3))
|
|
|
|
var1a%st%s = 1243
|
|
var2a(3)%at(2) = T(123, [345,64,356,39,13])
|
|
var2a(3)%at(3) = T(48, [74,162,572,357,3])
|
|
if (var1 /= var1) error stop
|
|
if (any (var2a /= var2)) error stop
|
|
if (any (var3a /= var3)) error stop
|
|
|
|
! ---------------
|
|
|
|
var3(1) = var2(1)
|
|
var1%at(2)%a = var2(1)%a
|
|
var1%at(3)%a = var2(2)%a
|
|
|
|
var1a = var1
|
|
var2a = var2
|
|
var3a = var3
|
|
|
|
!$omp target update to(var3) to(var1%at(2:3))
|
|
|
|
!$omp target
|
|
var3(1)%s = var3(1)%s + 123
|
|
var1%at(2)%a = var1%at(2)%a * 7
|
|
var1%at(3)%s = var1%at(3)%s * (-3)
|
|
!$omp end target
|
|
|
|
if (.not. shared_memory) then
|
|
if (var1 /= var1) error stop
|
|
if (any (var2a /= var2)) error stop
|
|
if (any (var3a /= var3)) error stop
|
|
endif
|
|
|
|
var3a(1)%s = var3a(1)%s + 123
|
|
var1a%at(2)%a = var1a%at(2)%a * 7
|
|
var1a%at(3)%s = var1a%at(3)%s * (-3)
|
|
|
|
block
|
|
integer, volatile :: i1,i2,i3,i4
|
|
i1 = 1
|
|
i2 = 2
|
|
i3 = 1
|
|
i4 = 2
|
|
!$omp target update from(var3(i1:i2)) from(var1%at(i3:i4))
|
|
i1 = 3
|
|
i2 = 3
|
|
i3 = 1
|
|
i4 = 5
|
|
!$omp target update from(var1%at(i1)%s) from(var1%at(i2)%a(i3:i4))
|
|
end block
|
|
|
|
if (var1 /= var1) error stop
|
|
if (any (var2a /= var2)) error stop
|
|
if (any (var3a /= var3)) error stop
|
|
|
|
! ---------------
|
|
|
|
!$omp target exit data map(from:var1)
|
|
!$omp target exit data map(from:var2)
|
|
!$omp target exit data map(from:var3)
|
|
end
|