diff options
author | Julian Brown <julian@codesourcery.com> | 2019-12-20 01:39:49 +0000 |
---|---|---|
committer | Julian Brown <jules@gcc.gnu.org> | 2019-12-20 01:39:49 +0000 |
commit | 9be3ac5d63f0f0d79d220bb3a10842b28a1e48ad (patch) | |
tree | c4426113e90ebe5b42363af5610987218e468d1b /libgomp | |
parent | 02817027ca02f32cfd4fbaa71edf879a024089a3 (diff) | |
download | gcc-9be3ac5d63f0f0d79d220bb3a10842b28a1e48ad.zip gcc-9be3ac5d63f0f0d79d220bb3a10842b28a1e48ad.tar.gz gcc-9be3ac5d63f0f0d79d220bb3a10842b28a1e48ad.tar.bz2 |
Fortran polymorphic class-type support for OpenACC
gcc/fortran/
* openmp.c (resolve_oacc_data_clauses): Don't disallow allocatable
polymorphic types for OpenACC.
* trans-openmp.c (gfc_trans_omp_clauses): Support polymorphic class
types.
libgomp/
* testsuite/libgomp.oacc-fortran/class-ptr-param.f95: New test.
* testsuite/libgomp.oacc-fortran/classtypes-1.f95: New test.
* testsuite/libgomp.oacc-fortran/classtypes-2.f95: New test.
From-SVN: r279631
Diffstat (limited to 'libgomp')
-rw-r--r-- | libgomp/ChangeLog | 6 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 | 34 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 | 48 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 | 106 |
4 files changed, 194 insertions, 0 deletions
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index b4aa47d..81b9d67 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,4 +1,10 @@ 2019-12-19 Julian Brown <julian@codesourcery.com> + + * testsuite/libgomp.oacc-fortran/class-ptr-param.f95: New test. + * testsuite/libgomp.oacc-fortran/classtypes-1.f95: New test. + * testsuite/libgomp.oacc-fortran/classtypes-2.f95: New test. + +2019-12-19 Julian Brown <julian@codesourcery.com> Cesar Philippidis <cesar@codesourcery.com> * testsuite/libgomp.oacc-fortran/deep-copy-1.f90: New test. diff --git a/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 b/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 new file mode 100644 index 0000000..8014733 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 @@ -0,0 +1,34 @@ +! { dg-do run } + +module typemod + +type mytype + integer :: a +end type mytype + +contains + +subroutine mysub(c) + implicit none + + class(mytype), allocatable :: c + +!$acc parallel copy(c) + c%a = 5 +!$acc end parallel +end subroutine mysub + +end module typemod + +program main + use typemod + implicit none + + class(mytype), allocatable :: myvar + allocate(mytype :: myvar) + + myvar%a = 0 + call mysub(myvar) + + if (myvar%a .ne. 5) stop 1 +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 new file mode 100644 index 0000000..f16f42f --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 @@ -0,0 +1,48 @@ +! { dg-do run } + +module typemod + +type :: typeimpl + real, pointer :: p(:) => null() +end type typeimpl + +type :: basictype + class(typeimpl), pointer :: p => null() +end type basictype + +type, extends(basictype) :: regulartype + character :: void +end type regulartype + +end module typemod + +program main + use typemod + implicit none + type(regulartype), pointer :: myvar + integer :: i + real :: j, k + + allocate(myvar) + allocate(myvar%p) + allocate(myvar%p%p(1:100)) + + do i=1,100 + myvar%p%p(i) = -1.0 + end do + +!$acc enter data copyin(myvar, myvar%p) create(myvar%p%p) + +!$acc parallel loop present(myvar%p%p) + do i=1,100 + myvar%p%p(i) = i * 2 + end do +!$acc end parallel loop + +!$acc exit data copyout(myvar%p%p) delete(myvar, myvar%p) + + do i=1,100 + if (myvar%p%p(i) .ne. i * 2) stop 1 + end do + +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 new file mode 100644 index 0000000..ad80ec2 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 @@ -0,0 +1,106 @@ +! { dg-do run } + +module wrapper_mod + +type compute + integer, allocatable :: block(:,:) +contains + procedure :: initialize +end type compute + +type, extends(compute) :: cpu_compute + integer :: blocksize +contains + procedure :: setblocksize +end type cpu_compute + +type, extends(compute) :: gpu_compute + integer :: numgangs + integer :: numworkers + integer :: vectorsize + integer, allocatable :: gpu_block(:,:) +contains + procedure :: setdims +end type gpu_compute + +contains + +subroutine initialize(c, length, width) + implicit none + class(compute) :: c + integer :: length + integer :: width + integer :: i + integer :: j + + allocate (c%block(length, width)) + + do i=1,length + do j=1, width + c%block(i,j) = i + j + end do + end do +end subroutine initialize + +subroutine setdims(c, g, w, v) + implicit none + class(gpu_compute) :: c + integer :: g + integer :: w + integer :: v + c%numgangs = g + c%numworkers = w + c%vectorsize = v +end subroutine setdims + +subroutine setblocksize(c, bs) + implicit none + class(cpu_compute) :: c + integer :: bs + c%blocksize = bs +end subroutine setblocksize + +end module wrapper_mod + +program main + use wrapper_mod + implicit none + class(compute), allocatable, target :: mycomp + integer :: i, j + + allocate(gpu_compute::mycomp) + + call mycomp%initialize(1024,1024) + + !$acc enter data copyin(mycomp) + + select type (mycomp) + type is (cpu_compute) + call mycomp%setblocksize(32) + type is (gpu_compute) + call mycomp%setdims(32,32,32) + allocate(mycomp%gpu_block(1024,1024)) + !$acc update device(mycomp) + !$acc parallel copyin(mycomp%block) copyout(mycomp%gpu_block) + !$acc loop gang worker vector collapse(2) + do i=1,1024 + do j=1,1024 + mycomp%gpu_block(i,j) = mycomp%block(i,j) + 1 + end do + end do + !$acc end parallel + end select + + !$acc exit data copyout(mycomp) + + select type (g => mycomp) + type is (gpu_compute) + do i = 1, 1024 + do j = 1, 1024 + if (g%gpu_block(i,j) .ne. i + j + 1) stop 1 + end do + end do + end select + + deallocate(mycomp) +end program main |