diff options
| author | yroux <yroux@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-16 14:43:37 +0000 |
|---|---|---|
| committer | yroux <yroux@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-16 14:43:37 +0000 |
| commit | 22f273dd122dd5e98dc9cfac46679d5ae9820f39 (patch) | |
| tree | d900c1f5612876011350fce385e3405b655aed32 /libgomp | |
| parent | adbd300ac2f701398d973750759b0460c8c79364 (diff) | |
| download | linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.tar.gz linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.tar.bz2 linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.zip | |
Merge branches/gcc-4_9-branch rev 212419
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/linaro/gcc-4_9-branch@212661 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgomp')
62 files changed, 4764 insertions, 4 deletions
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index aaa7ddec68f..00e34875ead 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,105 @@ +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * testsuite/libgomp.fortran/simd5.f90: New test. + * testsuite/libgomp.fortran/simd6.f90: New test. + * testsuite/libgomp.fortran/simd7.f90: New test. + + 2014-06-24 Jakub Jelinek <jakub@redhat.com> + + * testsuite/libgomp.fortran/aligned1.f03: New test. + * testsuite/libgomp.fortran/nestedfn5.f90: New test. + * testsuite/libgomp.fortran/target7.f90: Surround loop spawning + tasks with !$omp parallel !$omp single. + * testsuite/libgomp.fortran/target8.f90: New test. + * testsuite/libgomp.fortran/udr4.f90 (foo UDR, bar UDR): Adjust + not to use trim in the combiner, instead call elemental function. + (fn): New elemental function. + * testsuite/libgomp.fortran/udr6.f90 (do_add, dp_add, dp_init): + Make elemental. + * testsuite/libgomp.fortran/udr7.f90 (omp_priv, omp_orig, omp_out, + omp_in): Likewise. + * testsuite/libgomp.fortran/udr12.f90: New test. + * testsuite/libgomp.fortran/udr13.f90: New test. + * testsuite/libgomp.fortran/udr14.f90: New test. + * testsuite/libgomp.fortran/udr15.f90: New test. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * omp_lib.f90.in (openmp_version): Set to 201307. + * omp_lib.h.in (openmp_version): Likewise. + * testsuite/libgomp.c/target-8.c: New test. + * testsuite/libgomp.fortran/declare-simd-1.f90: Add notinbranch + and inbranch clauses. + * testsuite/libgomp.fortran/depend-3.f90: New test. + * testsuite/libgomp.fortran/openmp_version-1.f: Adjust for new + openmp_version. + * testsuite/libgomp.fortran/openmp_version-2.f90: Likewise. + * testsuite/libgomp.fortran/target1.f90: New test. + * testsuite/libgomp.fortran/target2.f90: New test. + * testsuite/libgomp.fortran/target3.f90: New test. + * testsuite/libgomp.fortran/target4.f90: New test. + * testsuite/libgomp.fortran/target5.f90: New test. + * testsuite/libgomp.fortran/target6.f90: New test. + * testsuite/libgomp.fortran/target7.f90: New test. + + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * testsuite/libgomp.fortran/allocatable9.f90: New test. + * testsuite/libgomp.fortran/allocatable10.f90: New test. + * testsuite/libgomp.fortran/allocatable11.f90: New test. + * testsuite/libgomp.fortran/allocatable12.f90: New test. + * testsuite/libgomp.fortran/alloc-comp-1.f90: New test. + * testsuite/libgomp.fortran/alloc-comp-2.f90: New test. + * testsuite/libgomp.fortran/alloc-comp-3.f90: New test. + * testsuite/libgomp.fortran/associate1.f90: New test. + * testsuite/libgomp.fortran/associate2.f90: New test. + * testsuite/libgomp.fortran/procptr1.f90: New test. + + 2014-06-06 Jakub Jelinek <jakub@redhat.com> + + * testsuite/libgomp.fortran/simd1.f90: New test. + * testsuite/libgomp.fortran/udr1.f90: New test. + * testsuite/libgomp.fortran/udr2.f90: New test. + * testsuite/libgomp.fortran/udr3.f90: New test. + * testsuite/libgomp.fortran/udr4.f90: New test. + * testsuite/libgomp.fortran/udr5.f90: New test. + * testsuite/libgomp.fortran/udr6.f90: New test. + * testsuite/libgomp.fortran/udr7.f90: New test. + * testsuite/libgomp.fortran/udr8.f90: New test. + * testsuite/libgomp.fortran/udr9.f90: New test. + * testsuite/libgomp.fortran/udr10.f90: New test. + * testsuite/libgomp.fortran/udr11.f90: New test. + + 2014-05-27 Uros Bizjak <ubizjak@gmail.com> + + * testsuite/libgomp.fortran/declare-simd-1.f90: Require + vect_simd_clones effective target. + * testsuite/libgomp.fortran/declare-simd-2.f90: Ditto. + + 2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * testsuite/libgomp.fortran/cancel-do-1.f90: New test. + * testsuite/libgomp.fortran/cancel-do-2.f90: New test. + * testsuite/libgomp.fortran/cancel-parallel-1.f90: New test. + * testsuite/libgomp.fortran/cancel-parallel-3.f90: New test. + * testsuite/libgomp.fortran/cancel-sections-1.f90: New test. + * testsuite/libgomp.fortran/cancel-taskgroup-2.f90: New test. + * testsuite/libgomp.fortran/declare-simd-1.f90: New test. + * testsuite/libgomp.fortran/declare-simd-2.f90: New test. + * testsuite/libgomp.fortran/declare-simd-3.f90: New test. + * testsuite/libgomp.fortran/depend-1.f90: New test. + * testsuite/libgomp.fortran/depend-2.f90: New test. + * testsuite/libgomp.fortran/omp_atomic5.f90: New test. + * testsuite/libgomp.fortran/simd1.f90: New test. + * testsuite/libgomp.fortran/simd2.f90: New test. + * testsuite/libgomp.fortran/simd3.f90: New test. + * testsuite/libgomp.fortran/simd4.f90: New test. + * testsuite/libgomp.fortran/taskgroup1.f90: New test. + 2014-06-24 Jakub Jelinek <jakub@redhat.com> * testsuite/libgomp.c/for-2.c: Define SC to static for diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in index dda297a1d4e..757053c9fbc 100644 --- a/libgomp/omp_lib.f90.in +++ b/libgomp/omp_lib.f90.in @@ -42,7 +42,7 @@ module omp_lib use omp_lib_kinds implicit none - integer, parameter :: openmp_version = 201107 + integer, parameter :: openmp_version = 201307 interface subroutine omp_init_lock (svar) diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in index 7725396ac50..691adb8655f 100644 --- a/libgomp/omp_lib.h.in +++ b/libgomp/omp_lib.h.in @@ -45,7 +45,7 @@ parameter (omp_proc_bind_master = 2) parameter (omp_proc_bind_close = 3) parameter (omp_proc_bind_spread = 4) - parameter (openmp_version = 201107) + parameter (openmp_version = 201307) external omp_init_lock, omp_init_nest_lock external omp_destroy_lock, omp_destroy_nest_lock diff --git a/libgomp/testsuite/libgomp.c/target-8.c b/libgomp/testsuite/libgomp.c/target-8.c new file mode 100644 index 00000000000..35084575324 --- /dev/null +++ b/libgomp/testsuite/libgomp.c/target-8.c @@ -0,0 +1,26 @@ +/* { dg-do run } */ +/* { dg-options "-fopenmp" } */ + +void +foo (int *p) +{ + int i; + #pragma omp parallel + #pragma omp single + #pragma omp target teams distribute parallel for map(p[0:24]) + for (i = 0; i < 24; i++) + p[i] = p[i] + 1; +} + +int +main () +{ + int p[24], i; + for (i = 0; i < 24; i++) + p[i] = i; + foo (p); + for (i = 0; i < 24; i++) + if (p[i] != i + 1) + __builtin_abort (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.fortran/aligned1.f03 b/libgomp/testsuite/libgomp.fortran/aligned1.f03 new file mode 100644 index 00000000000..67a9ab40423 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/aligned1.f03 @@ -0,0 +1,133 @@ +! { dg-do run } +! { dg-options "-fopenmp -fcray-pointer" } + + use iso_c_binding, only : c_ptr, c_ptrdiff_t, c_loc + interface + subroutine foo (x, y, z, w) + use iso_c_binding, only : c_ptr + real, pointer :: x(:), y(:), w(:) + type(c_ptr) :: z + end subroutine + subroutine bar (x, y, z, w) + use iso_c_binding, only : c_ptr + real, pointer :: x(:), y(:), w(:) + type(c_ptr) :: z + end subroutine + subroutine baz (x, c) + real, pointer :: x(:) + real, allocatable :: c(:) + end subroutine + end interface + type dt + real, allocatable :: a(:) + end type + type (dt) :: b(64) + real, target :: a(4096+63) + real, pointer :: p(:), q(:), r(:), s(:) + real, allocatable :: c(:) + integer(c_ptrdiff_t) :: o + integer :: i + o = 64 - mod (loc (a), 64) + if (o == 64) o = 0 + o = o / sizeof(0.0) + p => a(o + 1:o + 1024) + q => a(o + 1025:o + 2048) + r => a(o + 2049:o + 3072) + s => a(o + 3073:o + 4096) + do i = 1, 1024 + p(i) = i + q(i) = i + r(i) = i + s(i) = i + end do + call foo (p, q, c_loc (r(1)), s) + do i = 1, 1024 + if (p(i) /= i * i + 3 * i + 2) call abort + p(i) = i + end do + call bar (p, q, c_loc (r(1)), s) + do i = 1, 1024 + if (p(i) /= i * i + 3 * i + 2) call abort + end do + ! Attempt to create 64-byte aligned allocatable + do i = 1, 64 + allocate (c(1023 + i)) + if (iand (loc (c(1)), 63) == 0) exit + deallocate (c) + allocate (b(i)%a(1023 + i)) + allocate (c(1023 + i)) + if (iand (loc (c(1)), 63) == 0) exit + deallocate (c) + end do + if (allocated (c)) then + do i = 1, 1024 + c(i) = 2 * i + end do + call baz (p, c) + do i = 1, 1024 + if (p(i) /= i * i + 5 * i + 2) call abort + end do + end if +end +subroutine foo (x, y, z, w) + use iso_c_binding, only : c_ptr, c_f_pointer + real, pointer :: x(:), y(:), w(:), p(:) + type(c_ptr) :: z + integer :: i + real :: pt(1024) + pointer (ip, pt) + ip = loc (w) +!$omp simd aligned (x, y : 64) + do i = 1, 1024 + x(i) = x(i) * y(i) + 2.0 + end do +!$omp simd aligned (x, z : 64) private (p) + do i = 1, 1024 + call c_f_pointer (z, p, shape=[1024]) + x(i) = x(i) + p(i) + end do +!$omp simd aligned (x, ip : 64) + do i = 1, 1024 + x(i) = x(i) + 2 * pt(i) + end do +!$omp end simd +end subroutine +subroutine bar (x, y, z, w) + use iso_c_binding, only : c_ptr, c_f_pointer + real, pointer :: x(:), y(:), w(:), a(:), b(:) + type(c_ptr) :: z, c + integer :: i + real :: pt(1024) + pointer (ip, pt) + ip = loc (w) + a => x + b => y + c = z +!$omp simd aligned (a, b : 64) + do i = 1, 1024 + a(i) = a(i) * b(i) + 2.0 + end do +!$omp simd aligned (a, c : 64) + do i = 1, 1024 + block + real, pointer :: p(:) + call c_f_pointer (c, p, shape=[1024]) + a(i) = a(i) + p(i) + end block + end do +!$omp simd aligned (a, ip : 64) + do i = 1, 1024 + a(i) = a(i) + 2 * pt(i) + end do +!$omp end simd +end subroutine +subroutine baz (x, c) + real, pointer :: x(:) + real, allocatable :: c(:) + integer :: i +!$omp simd aligned (x, c : 64) + do i = 1, 1024 + x(i) = x(i) + c(i) + end do +!$omp end simd +end subroutine baz diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 new file mode 100644 index 00000000000..2a2a12ec817 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 @@ -0,0 +1,328 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt) :: y + call foo (y) +contains + subroutine foo (y) + use m + type (dt) :: x, y, z(-3:-3,2:3) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x%h, x%k) + deallocate (y%h) + allocate (y%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 new file mode 100644 index 00000000000..490ed24cf4f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 @@ -0,0 +1,367 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt), allocatable :: y + call foo (y) +contains + subroutine foo (y) + use m + type (dt), allocatable :: x, y, z(:,:) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l +!$omp parallel private (x, y, z) + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort +!$omp end parallel +!$omp parallel firstprivate (x, y, z) + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort +!$omp end parallel + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (.not. l) then + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort + end if +!$omp section + if (.not. l) then + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort + end if + allocate (x, y, z(-3:-3,2:3)) + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + if (.not.allocated (x) .or. .not.allocated (y)) call abort + if (.not.allocated (z)) call abort + if (lbound (z, 1) /= -3 .or. ubound (z, 1) /= -3) call abort + if (lbound (z, 2) /= 2 .or. ubound (z, 2) /= 3) call abort + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x%h, x%k) + deallocate (y%h) + allocate (y%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 new file mode 100644 index 00000000000..20f13144a62 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 @@ -0,0 +1,372 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt), allocatable :: z(:,:) + type (dt) :: y(2:3) + call foo (y, z, 4) +contains + subroutine foo (y, z, n) + use m + integer :: n + type (dt) :: x(2:n), y(3:) + type (dt), allocatable :: z(:,:) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l + if (lbound (x, 1) /= 2 .or. ubound (x, 1) /= 4) call abort + if (lbound (y, 1) /= 3 .or. ubound (y, 1) /= 4) call abort + call ver_dt (x(2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x(n), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (z) + if (allocated (z)) call abort +!$omp end parallel +!$omp parallel firstprivate (z) + if (allocated (z)) call abort +!$omp end parallel + l = F +!$omp parallel sections lastprivate (z) firstprivate (l) +!$omp section + if (.not. l) then + if (allocated (z)) call abort + end if +!$omp section + if (.not. l) then + if (allocated (z)) call abort + end if + allocate (z(-3:-3,2:3)) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + if (.not.allocated (z)) call abort + if (lbound (z, 1) /= -3 .or. ubound (z, 1) /= -3) call abort + if (lbound (z, 2) /= 2 .or. ubound (z, 2) /= 3) call abort + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x(n - 1)%h, x(n - 1)%k) + deallocate (y(4)%h) + allocate (y(4)%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + if (lbound (x, 1) /= 2 .or. ubound (x, 1) /= 4) call abort + if (lbound (y, 1) /= 3 .or. ubound (y, 1) /= 4) call abort + call ver_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y(4), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y(4), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y(4), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x(n - 1), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x(n - 1), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (x(2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x(n), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable10.f90 b/libgomp/testsuite/libgomp.fortran/allocatable10.f90 new file mode 100644 index 00000000000..54eed617b45 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable10.f90 @@ -0,0 +1,112 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + integer :: i +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) & +!$omp & initializer (omp_priv = 0) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(6:9), c(3, 8:9)) + a = 0 + b = 0 + c = 0 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort +!$omp parallel do reduction (+:a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp parallel do reduction (foo : a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp simd reduction (+:a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp simd reduction (foo : a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable11.f90 b/libgomp/testsuite/libgomp.fortran/allocatable11.f90 new file mode 100644 index 00000000000..479f6041b7d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable11.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + + use omp_lib + integer, allocatable, save :: a, b(:), c(:,:) + integer :: p +!$omp threadprivate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) + +!$omp parallel num_threads (4) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp end parallel + + allocate (a, b(6:9), c(3, 8:9)) + a = 4 + b = 5 + c = 6 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + +!$omp parallel num_threads (4) copyin (a, b, c) private (p) + p = omp_get_thread_num () + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 4 .or. any (b /= 5) .or. any (c /= 6)) call abort + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(p:9), c(3, p:7)) + a = p + b = p + c = p + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= (10 - p)) call abort + if (lbound (b, 1) /= p .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= (3 * (8 - p))) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= (8 - p)) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= p .or. ubound (c, 2) /= 7) call abort + if (a /= p .or. any (b /= p) .or. any (c /= p)) call abort +!$omp end parallel + +!$omp parallel num_threads (4) copyin (a, b, c) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 10) call abort + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 24) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 8) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 0 .or. ubound (c, 2) /= 7) call abort + if (a /= 0 .or. any (b /= 0) .or. any (c /= 0)) call abort +!$omp end parallel + + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp parallel num_threads (4) copyin (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable12.f90 b/libgomp/testsuite/libgomp.fortran/allocatable12.f90 new file mode 100644 index 00000000000..533ab7cd85d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable12.f90 @@ -0,0 +1,74 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + logical :: l + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp parallel private (a, b, c, l) + l = .false. + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp single + allocate (a, b(6:9), c(3, 8:9)) + a = 4 + b = 5 + c = 6 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 4 .or. any (b /= 5) .or. any (c /= 6)) call abort + +!$omp single + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(0:4), c(3, 2:7)) + a = 1 + b = 2 + c = 3 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 5) call abort + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 4) call abort + if (.not.allocated (c) .or. size (c) /= 18) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 6) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 2 .or. ubound (c, 2) /= 7) call abort + if (a /= 1 .or. any (b /= 2) .or. any (c /= 3)) call abort + +!$omp single + l = .true. + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(2:6), c(3:5, 3:8)) + a = 7 + b = 8 + c = 9 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 5) call abort + if (l) then + if (lbound (b, 1) /= 2 .or. ubound (b, 1) /= 6) call abort + else + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 4) call abort + end if + if (.not.allocated (c) .or. size (c) /= 18) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 6) call abort + if (l) then + if (lbound (c, 1) /= 3 .or. ubound (c, 1) /= 5) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 8) call abort + else + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 2 .or. ubound (c, 2) /= 7) call abort + end if + if (a /= 7 .or. any (b /= 8) .or. any (c /= 9)) call abort + +!$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable9.f90 b/libgomp/testsuite/libgomp.fortran/allocatable9.f90 new file mode 100644 index 00000000000..80bf5d389f3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable9.f90 @@ -0,0 +1,156 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + logical :: l + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp parallel private (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(-7:-1), c(2:3, 3:5)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 7) call abort + if (lbound (b, 1) /= -7 .or. ubound (b, 1) /= -1) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 3) call abort + if (lbound (c, 1) /= 2 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 5) call abort + a = 4 + b = 3 + c = 2 +!$omp end parallel + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp parallel firstprivate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(-7:-1), c(2:3, 3:5)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 7) call abort + if (lbound (b, 1) /= -7 .or. ubound (b, 1) /= -1) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 3) call abort + if (lbound (c, 1) /= 2 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 5) call abort + a = 4 + b = 3 + c = 2 +!$omp end parallel + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(6:9), c(3, 8:9)) + a = 2 + b = 4 + c = 5 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort +!$omp parallel firstprivate (a, b, c) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 2 .or. any (b .ne. 4) .or. any (c .ne. 5)) call abort + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 8 + b = (/ 1, 2, 3 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 2, 4 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort +!$omp end parallel + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 2 .or. any (b .ne. 4) .or. any (c .ne. 5)) call abort + l = .false. +!$omp parallel sections lastprivate (a, b, c) firstprivate (l) +!$omp section + if (.not.allocated (a)) call abort + if (l) then + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort + else + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + end if + l = .true. + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 8 + b = (/ 1, 2, 3 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 2, 4 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort +!$omp section + if (.not.allocated (a)) call abort + if (l) then + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort + else + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + end if + l = .true. + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 12 + b = (/ 9, 8, 7, 6, 5, 4 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 4, 2 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort +!$omp end parallel sections + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/associate1.f90 b/libgomp/testsuite/libgomp.fortran/associate1.f90 new file mode 100644 index 00000000000..e40995515d8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/associate1.f90 @@ -0,0 +1,23 @@ +! { dg-do run } + +program associate1 + integer :: v, i, j + real :: a(3, 3) + v = 15 + a = 4.5 + a(2,1) = 3.5 + i = 2 + j = 1 + associate(u => v, b => a(i, j)) +!$omp parallel private(v, a) default(none) + v = -1 + a = 2.5 + if (v /= -1 .or. u /= 15) call abort + if (a(2,1) /= 2.5 .or. b /= 3.5) call abort + associate(u => v, b => a(2, 1)) + if (u /= -1 .or. b /= 2.5) call abort + end associate + if (u /= 15 .or. b /= 3.5) call abort +!$omp end parallel + end associate +end program diff --git a/libgomp/testsuite/libgomp.fortran/associate2.f90 b/libgomp/testsuite/libgomp.fortran/associate2.f90 new file mode 100644 index 00000000000..dee8496e1d7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/associate2.f90 @@ -0,0 +1,46 @@ +! { dg-do run } + +program associate2 + type dl + integer :: i + end type + type dt + integer :: i + real :: a(3, 3) + type(dl) :: c(3, 3) + end type + integer :: v(4), i, j, k, l + type (dt) :: a(3, 3) + v = 15 + forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 4.5 + a(2,1)%a(1,2) = 3.5 + i = 2 + j = 1 + associate(u => v, b => a(i, j)%a) +!$omp parallel private(v, a) default(none) + v = -1 + forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 2.5 + if (v(3) /= -1 .or. u(3) /= 15) call abort + if (a(2,1)%a(1,2) /= 2.5 .or. b(1,2) /= 3.5) call abort + associate(u => v, b => a(2, 1)%a) + if (u(3) /= -1 .or. b(1,2) /= 2.5) call abort + end associate + if (u(3) /= 15 .or. b(1,2) /= 3.5) call abort +!$omp end parallel + end associate + forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 7 + a(1,2)%c(2,1)%i = 9 + i = 1 + j = 2 + associate(d => a(i, j)%c(2,:)%i) +!$omp parallel private(a) default(none) + forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 15 + if (a(1,2)%c(2,1)%i /= 15 .or. d(1) /= 9) call abort + if (a(1,2)%c(2,2)%i /= 15 .or. d(2) /= 7) call abort + associate(d => a(2,1)%c(2,:)%i) + if (d(1) /= 15 .or. d(2) /= 15) call abort + end associate + if (d(1) /= 9 .or. d(2) /= 7) call abort +!$omp end parallel + end associate +end program diff --git a/libgomp/testsuite/libgomp.fortran/cancel-do-1.f90 b/libgomp/testsuite/libgomp.fortran/cancel-do-1.f90 new file mode 100644 index 00000000000..61713c4dd94 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-do-1.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + integer :: i + + !$omp parallel num_threads(32) + !$omp do + do i = 0, 999 + !$omp cancel do + if (omp_get_cancellation ()) call abort + enddo + !$omp endparallel +end diff --git a/libgomp/testsuite/libgomp.fortran/cancel-do-2.f90 b/libgomp/testsuite/libgomp.fortran/cancel-do-2.f90 new file mode 100644 index 00000000000..c748800cad5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-do-2.f90 @@ -0,0 +1,90 @@ +! { dg-do run } +! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + integer :: i + logical :: x(5) + + x(:) = .false. + x(1) = .true. + x(3) = .true. + if (omp_get_cancellation ()) call foo (x) +contains + subroutine foo (x) + use omp_lib + logical :: x(5) + integer :: v, w, i + + v = 0 + w = 0 + !$omp parallel num_threads (32) shared (v, w) + !$omp do + do i = 0, 999 + !$omp cancel do if (x(1)) + call abort + end do + !$omp do + do i = 0, 999 + !$omp cancel do if (x(2)) + !$omp atomic + v = v + 1 + !$omp endatomic + enddo + !$omp do + do i = 0, 999 + !$omp cancel do if (x(3)) + !$omp atomic + w = w + 8 + !$omp end atomic + end do + !$omp do + do i = 0, 999 + !$omp cancel do if (x(4)) + !$omp atomic + v = v + 2 + !$omp end atomic + end do + !$omp end do + !$omp end parallel + if (v.ne.3000.or.w.ne.0) call abort + !$omp parallel num_threads (32) shared (v, w) + ! None of these cancel directives should actually cancel anything, + ! but the compiler shouldn't know that and thus should use cancellable + ! barriers at the end of all the workshares. + !$omp cancel parallel if (omp_get_thread_num ().eq.1.and.x(5)) + !$omp do + do i = 0, 999 + !$omp cancel do if (x(1)) + call abort + end do + !$omp cancel parallel if (omp_get_thread_num ().eq.2.and.x(5)) + !$omp do + do i = 0, 999 + !$omp cancel do if (x(2)) + !$omp atomic + v = v + 1 + !$omp endatomic + enddo + !$omp cancel parallel if (omp_get_thread_num ().eq.3.and.x(5)) + !$omp do + do i = 0, 999 + !$omp cancel do if (x(3)) + !$omp atomic + w = w + 8 + !$omp end atomic + end do + !$omp cancel parallel if (omp_get_thread_num ().eq.4.and.x(5)) + !$omp do + do i = 0, 999 + !$omp cancel do if (x(4)) + !$omp atomic + v = v + 2 + !$omp end atomic + end do + !$omp end do + !$omp cancel parallel if (omp_get_thread_num ().eq.5.and.x(5)) + !$omp end parallel + if (v.ne.6000.or.w.ne.0) call abort + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/cancel-parallel-1.f90 b/libgomp/testsuite/libgomp.fortran/cancel-parallel-1.f90 new file mode 100644 index 00000000000..7d91ff5c169 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-parallel-1.f90 @@ -0,0 +1,10 @@ +! { dg-do run } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + + !$omp parallel num_threads(32) + !$omp cancel parallel + if (omp_get_cancellation ()) call abort + !$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/cancel-parallel-3.f90 b/libgomp/testsuite/libgomp.fortran/cancel-parallel-3.f90 new file mode 100644 index 00000000000..9d5ba8ffa38 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-parallel-3.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + integer :: x, i, j + common /x/ x + + call omp_set_dynamic (.false.) + call omp_set_schedule (omp_sched_static, 1) + !$omp parallel num_threads(16) private (i, j) + call do_some_work + !$omp barrier + if (omp_get_thread_num ().eq.1) then + call sleep (2) + !$omp cancellation point parallel + end if + do j = 3, 16 + !$omp do schedule(runtime) + do i = 0, j - 1 + call do_some_work + end do + !$omp enddo nowait + end do + if (omp_get_thread_num ().eq.0) then + call sleep (1) + !$omp cancel parallel + end if + !$omp end parallel +contains + subroutine do_some_work + integer :: x + common /x/ x + !$omp atomic + x = x + 1 + !$omp end atomic + endsubroutine do_some_work +end diff --git a/libgomp/testsuite/libgomp.fortran/cancel-sections-1.f90 b/libgomp/testsuite/libgomp.fortran/cancel-sections-1.f90 new file mode 100644 index 00000000000..9ba8af84679 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-sections-1.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + + if (omp_get_cancellation ()) then + !$omp parallel num_threads(32) + !$omp sections + !$omp cancel sections + call abort + !$omp section + !$omp cancel sections + call abort + !$omp section + !$omp cancel sections + call abort + !$omp section + !$omp cancel sections + call abort + !$omp end sections + !$omp end parallel + end if +end diff --git a/libgomp/testsuite/libgomp.fortran/cancel-taskgroup-2.f90 b/libgomp/testsuite/libgomp.fortran/cancel-taskgroup-2.f90 new file mode 100644 index 00000000000..c727a20ae41 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/cancel-taskgroup-2.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-set-target-env-var OMP_CANCELLATION "true" } + + use omp_lib + integer :: i + + !$omp parallel + !$omp taskgroup + !$omp task + !$omp cancel taskgroup + call abort + !$omp endtask + !$omp endtaskgroup + !$omp endparallel + !$omp parallel private (i) + !$omp barrier + !$omp single + !$omp taskgroup + do i = 0, 49 + !$omp task + !$omp cancellation point taskgroup + !$omp cancel taskgroup if (i.gt.5) + !$omp end task + end do + !$omp end taskgroup + !$omp endsingle + !$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-simd-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-simd-1.f90 new file mode 100644 index 00000000000..5cd592c09db --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-simd-1.f90 @@ -0,0 +1,95 @@ +! { dg-do run { target vect_simd_clones } } +! { dg-options "-fno-inline" } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + +module declare_simd_1_mod + contains + real function foo (a, b, c) + !$omp declare simd (foo) simdlen (4) uniform (a) linear (b : 5) & + !$omp & notinbranch + double precision, value :: a + real, value :: c + !$omp declare simd (foo) + integer, value :: b + foo = a + b * c + end function foo +end module declare_simd_1_mod + use declare_simd_1_mod + interface + function bar (a, b, c) + !$omp declare simd (bar) + integer, value :: b + real, value :: c + real :: bar + !$omp declare simd (bar) simdlen (4) linear (b : 2) + !$omp declare simd (bar) simdlen (16) inbranch + double precision, value :: a + end function bar + end interface + integer :: i + double precision :: a(128) + real :: b(128), d(128) + data d /171., 414., 745., 1164., 1671., 2266., 2949., 3720., 4579., & + & 5526., 6561., 7684., 8895., 10194., 11581., 13056., 14619., & + & 16270., 18009., 19836., 21751., 23754., 25845., 28024., & + & 30291., 32646., 35089., 37620., 40239., 42946., 45741., & + & 48624., 51595., 54654., 57801., 61036., 64359., 67770., & + & 71269., 74856., 78531., 82294., 86145., 90084., 94111., & + & 98226., 102429., 106720., 111099., 115566., 120121., 124764., & + & 129495., 134314., 139221., 144216., 149299., 154470., 159729., & + & 165076., 170511., 176034., 181645., 187344., 193131., 199006., & + & 204969., 211020., 217159., 223386., 229701., 236104., 242595., & + & 249174., 255841., 262596., 269439., 276370., 283389., 290496., & + & 297691., 304974., 312345., 319804., 327351., 334986., 342709., & + & 350520., 358419., 366406., 374481., 382644., 390895., 399234., & + & 407661., 416176., 424779., 433470., 442249., 451116., 460071., & + & 469114., 478245., 487464., 496771., 506166., 515649., 525220., & + & 534879., 544626., 554461., 564384., 574395., 584494., 594681., & + & 604956., 615319., 625770., 636309., 646936., 657651., 668454., & + & 679345., 690324., 701391., 712546., 723789., 735120./ + !$omp simd + do i = 1, 128 + a(i) = 7.0 * i + 16.0 + b(i) = 5.0 * i + 12.0 + end do + !$omp simd + do i = 1, 128 + b(i) = foo (a(i), 3, b(i)) + end do + !$omp simd + do i = 1, 128 + b(i) = bar (a(i), 2 * i, b(i)) + end do + if (any (b.ne.d)) call abort + !$omp simd + do i = 1, 128 + b(i) = i * 2.0 + end do + !$omp simd + do i = 1, 128 + b(i) = baz (7.0_8, 2, b(i)) + end do + do i = 1, 128 + if (b(i).ne.(7.0 + 4.0 * i)) call abort + end do +contains + function baz (x, y, z) + !$omp declare simd (baz) simdlen (8) uniform (x, y) + !$omp declare simd (baz) + integer, value :: y + real, value :: z + real :: baz + double precision, value :: x + baz = x + y * z + end function baz +end +function bar (a, b, c) + integer, value :: b + real, value :: c + real :: bar + double precision, value :: a + !$omp declare simd (bar) + !$omp declare simd (bar) simdlen (4) linear (b : 2) + bar = a + b * c +end function bar diff --git a/libgomp/testsuite/libgomp.fortran/declare-simd-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-simd-2.f90 new file mode 100644 index 00000000000..30c63f706ef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-simd-2.f90 @@ -0,0 +1,25 @@ +! { dg-do run { target vect_simd_clones } } +! { dg-options "-fno-inline" } +! { dg-additional-sources declare-simd-3.f90 } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + +module declare_simd_2_mod + contains + real function foo (a, b, c) + !$omp declare simd (foo) simdlen (4) uniform (a) linear (b : 5) + double precision, value :: a + real, value :: c + !$omp declare simd (foo) + integer, value :: b + foo = a + b * c + end function foo +end module declare_simd_2_mod + + interface + subroutine bar () + end subroutine bar + end interface + + call bar () +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-simd-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-simd-3.f90 new file mode 100644 index 00000000000..031625ec435 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-simd-3.f90 @@ -0,0 +1,22 @@ +! Don't compile this anywhere, it is just auxiliary +! file compiled together with declare-simd-2.f90 +! to verify inter-CU module handling of omp declare simd. +! { dg-do compile { target { lp64 && { ! lp64 } } } } + +subroutine bar + use declare_simd_2_mod + real :: b(128) + integer :: i + + !$omp simd + do i = 1, 128 + b(i) = i * 2.0 + end do + !$omp simd + do i = 1, 128 + b(i) = foo (7.0_8, 5 * i, b(i)) + end do + do i = 1, 128 + if (b(i).ne.(7.0 + 10.0 * i * i)) call abort + end do +end subroutine bar diff --git a/libgomp/testsuite/libgomp.fortran/depend-1.f90 b/libgomp/testsuite/libgomp.fortran/depend-1.f90 new file mode 100644 index 00000000000..030d3fb6a55 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/depend-1.f90 @@ -0,0 +1,203 @@ +! { dg-do run } + + call dep () + call dep2 () + call dep3 () + call firstpriv () + call antidep () + call antidep2 () + call antidep3 () + call outdep () + call concurrent () + call concurrent2 () + call concurrent3 () +contains + subroutine dep + integer :: x + x = 1 + !$omp parallel + !$omp single + !$omp task shared (x) depend(out: x) + x = 2 + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp end single + !$omp end parallel + end subroutine dep + + subroutine dep2 + integer :: x + !$omp parallel + !$omp single private (x) + x = 1 + !$omp task shared (x) depend(out: x) + x = 2 + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp taskwait + !$omp end single + !$omp end parallel + end subroutine dep2 + + subroutine dep3 + integer :: x + !$omp parallel private (x) + x = 1 + !$omp single + !$omp task shared (x) depend(out: x) + x = 2 + !$omp endtask + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp endtask + !$omp endsingle + !$omp endparallel + end subroutine dep3 + + subroutine firstpriv + integer :: x + !$omp parallel private (x) + !$omp single + x = 1 + !$omp task depend(out: x) + x = 2 + !$omp end task + !$omp task depend(in: x) + if (x.ne.1) call abort + !$omp end task + !$omp end single + !$omp end parallel + end subroutine firstpriv + + subroutine antidep + integer :: x + x = 1 + !$omp parallel + !$omp single + !$omp task shared(x) depend(in: x) + if (x.ne.1) call abort + !$omp end task + !$omp task shared(x) depend(out: x) + x = 2 + !$omp end task + !$omp end single + !$omp end parallel + end subroutine antidep + + subroutine antidep2 + integer :: x + !$omp parallel private (x) + !$omp single + x = 1 + !$omp taskgroup + !$omp task shared(x) depend(in: x) + if (x.ne.1) call abort + !$omp end task + !$omp task shared(x) depend(out: x) + x = 2 + !$omp end task + !$omp end taskgroup + !$omp end single + !$omp end parallel + end subroutine antidep2 + + subroutine antidep3 + integer :: x + !$omp parallel + x = 1 + !$omp single + !$omp task shared(x) depend(in: x) + if (x.ne.1) call abort + !$omp end task + !$omp task shared(x) depend(out: x) + x = 2 + !$omp end task + !$omp end single + !$omp end parallel + end subroutine antidep3 + + subroutine outdep + integer :: x + !$omp parallel private (x) + !$omp single + x = 0 + !$omp task shared(x) depend(out: x) + x = 1 + !$omp end task + !$omp task shared(x) depend(out: x) + x = 2 + !$omp end task + !$omp taskwait + if (x.ne.2) call abort + !$omp end single + !$omp end parallel + end subroutine outdep + + subroutine concurrent + integer :: x + x = 1 + !$omp parallel + !$omp single + !$omp task shared (x) depend(out: x) + x = 2 + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp end single + !$omp end parallel + end subroutine concurrent + + subroutine concurrent2 + integer :: x + !$omp parallel private (x) + !$omp single + x = 1 + !$omp task shared (x) depend(out: x) + x = 2; + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp taskwait + !$omp end single + !$omp end parallel + end subroutine concurrent2 + + subroutine concurrent3 + integer :: x + !$omp parallel private (x) + x = 1 + !$omp single + !$omp task shared (x) depend(out: x) + x = 2 + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp task shared (x) depend(in: x) + if (x.ne.2) call abort + !$omp end task + !$omp end single + !$omp end parallel + end subroutine concurrent3 +end diff --git a/libgomp/testsuite/libgomp.fortran/depend-2.f90 b/libgomp/testsuite/libgomp.fortran/depend-2.f90 new file mode 100644 index 00000000000..0694ce74206 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/depend-2.f90 @@ -0,0 +1,34 @@ +! { dg-do run } + + integer :: x(3:6, 7:12), y + y = 1 + !$omp parallel shared (x, y) + !$omp single + !$omp taskgroup + !$omp task depend(in: x(:, :)) + if (y.ne.1) call abort + !$omp end task + !$omp task depend(out: x(:, :)) + y = 2 + !$omp end task + !$omp end taskgroup + !$omp taskgroup + !$omp task depend(in: x(4, 7)) + if (y.ne.2) call abort + !$omp end task + !$omp task depend(out: x(4:4, 7:7)) + y = 3 + !$omp end task + !$omp end taskgroup + !$omp taskgroup + !$omp task depend(in: x(4:, 8:)) + if (y.ne.3) call abort + !$omp end task + !$omp task depend(out: x(4:6, 8:12)) + y = 4 + !$omp end task + !$omp end taskgroup + !$omp end single + !$omp end parallel + if (y.ne.4) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/depend-3.f90 b/libgomp/testsuite/libgomp.fortran/depend-3.f90 new file mode 100644 index 00000000000..11be6410692 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/depend-3.f90 @@ -0,0 +1,42 @@ +! { dg-do run } + + integer :: x(2, 3) + integer, allocatable :: z(:, :) + allocate (z(-2:3, 2:4)) + call foo (x, z) +contains + subroutine foo (x, z) + integer :: x(:, :), y + integer, allocatable :: z(:, :) + y = 1 + !$omp parallel shared (x, y, z) + !$omp single + !$omp taskgroup + !$omp task depend(in: x) + if (y.ne.1) call abort + !$omp end task + !$omp task depend(out: x(1:2, 1:3)) + y = 2 + !$omp end task + !$omp end taskgroup + !$omp taskgroup + !$omp task depend(in: z) + if (y.ne.2) call abort + !$omp end task + !$omp task depend(out: z(-2:3, 2:4)) + y = 3 + !$omp end task + !$omp end taskgroup + !$omp taskgroup + !$omp task depend(in: x) + if (y.ne.3) call abort + !$omp end task + !$omp task depend(out: x(1:, 1:)) + y = 4 + !$omp end task + !$omp end taskgroup + !$omp end single + !$omp end parallel + if (y.ne.4) call abort + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 new file mode 100644 index 00000000000..f67bd47e17d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 @@ -0,0 +1,96 @@ +! { dg-do run } + + interface + subroutine bar (q) + integer :: q(19:) + end subroutine + end interface + integer :: q(7:15) + q(:) = 5 + call bar (q) +end +subroutine bar (q) + use iso_c_binding, only: c_ptr, c_loc, c_int + integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p + integer(c_int), target :: e(64) + type (c_ptr) :: f, g(64) + logical :: l + a = 1 + b = 2 + c = 3 + d = 4 + l = .false. + f = c_loc (e) + call foo +contains + subroutine foo + use iso_c_binding, only: c_sizeof +!$omp simd linear(a:2) linear(b:1) + do a = 1, 20, 2 + b = b + 1 + end do +!$omp end simd + if (a /= 21 .or. b /= 12) call abort +!$omp simd aligned(f : c_sizeof (e(1))) + do b = 1, 64 + g(b) = f + end do +!$omp end simd +!$omp parallel +!$omp single +!$omp taskgroup +!$omp task depend(out : a, d(2:2,4:5)) + a = a + 1 + d(2:2,4:5) = d(2:2,4:5) + 1 +!$omp end task +!$omp task depend(in : a, d(2:2,4:5)) + if (a /= 22) call abort + if (any (d(2:2,4:5) /= 5)) call abort +!$omp end task +!$omp end taskgroup +!$omp end single +!$omp end parallel + b = 10 +!$omp target data map (tofrom: a, d(2:3,4:4), q) map (from: l) +!$omp target map (tofrom: b, d(2:3,4:4)) + l = .false. + if (a /= 22 .or. any (q /= 5)) l = .true. + if (lbound (q, 1) /= 19 .or. ubound (q, 1) /= 27) l = .true. + if (d(2,4) /= 5 .or. d(3,4) /= 4) l = .true. + l = l .or. (b /= 10) + a = 6 + b = 11 + q = 8 + d(2:3,4:4) = 9 +!$omp end target +!$omp target update from (a, q, d(2:3,4:4), l) + if (a /= 6 .or. l .or. b /= 11 .or. any (q /= 8)) call abort + if (any (d(2:3,4:4) /= 9) .or. d(2,5) /= 5 .or. d(3,5) /= 4) call abort + a = 12 + b = 13 + q = 14 + d = 15 +!$omp target update to (a, q, d(2:3,4:4)) +!$omp target map (tofrom: b, d(2:3,4:4)) + if (a /= 12 .or. b /= 13 .or. any (q /= 14)) l = .true. + l = l .or. any (d(2:3,4:4) /= 15) +!$omp end target + a = 0 + b = 1 + c = 100 + h = 8 + m = 0 + n = 64 + o = 16 + if (l) call abort +!$omp target teams distribute parallel do simd if (.not.l) device(a) & +!$omp & num_teams(b) dist_schedule(static, c) num_threads (h) & +!$omp & reduction (+: m) safelen (n) schedule(static, o) + do p = 1, 64 + m = m + 1 + end do +!$omp end target teams distribute parallel do simd + if (m /= 64) call abort +!$omp end target data + end subroutine foo +end subroutine bar diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic5.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic5.f90 new file mode 100644 index 00000000000..8e0641592fd --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_atomic5.f90 @@ -0,0 +1,59 @@ +! { dg-do run } + integer (kind = 4) :: a, a2 + integer (kind = 2) :: b, b2 + real :: c + double precision :: d, d2, c2 + integer, dimension (10) :: e + e(:) = 5 + e(7) = 9 +!$omp atomic write seq_cst + a = 1 +!$omp atomic seq_cst, write + b = 2 +!$omp atomic write, seq_cst + c = 3 +!$omp atomic seq_cst write + d = 4 +!$omp atomic capture seq_cst + a2 = a + a = a + 4 +!$omp end atomic +!$omp atomic capture, seq_cst + b = b - 18 + b2 = b +!$omp end atomic +!$omp atomic seq_cst, capture + c2 = c + c = 2.0 * c +!$omp end atomic +!$omp atomic seq_cst capture + d = d / 2.0 + d2 = d +!$omp end atomic + if (a2 .ne. 1 .or. b2 .ne. -16 .or. c2 .ne. 3 .or. d2 .ne. 2) call abort +!$omp atomic read seq_cst + a2 = a +!$omp atomic seq_cst, read + c2 = c + if (a2 .ne. 5 .or. b2 .ne. -16 .or. c2 .ne. 6 .or. d2 .ne. 2) call abort + a2 = 10 + if (a2 .ne. 10) call abort +!$omp atomic capture + a2 = a + a = e(1) + e(6) + e(7) * 2 +!$omp endatomic + if (a2 .ne. 5) call abort +!$omp atomic read + a2 = a +!$omp end atomic + if (a2 .ne. 28) call abort +!$omp atomic capture seq_cst + b2 = b + b = e(1) + e(7) + e(5) * 2 +!$omp end atomic + if (b2 .ne. -16) call abort +!$omp atomic seq_cst, read + b2 = b +!$omp end atomic + if (b2 .ne. 24) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/openmp_version-1.f b/libgomp/testsuite/libgomp.fortran/openmp_version-1.f index aaa888189b1..be24adcca0c 100644 --- a/libgomp/testsuite/libgomp.fortran/openmp_version-1.f +++ b/libgomp/testsuite/libgomp.fortran/openmp_version-1.f @@ -4,6 +4,6 @@ implicit none include "omp_lib.h" - if (openmp_version .ne. 201107) call abort; + if (openmp_version .ne. 201307) call abort; end program main diff --git a/libgomp/testsuite/libgomp.fortran/openmp_version-2.f90 b/libgomp/testsuite/libgomp.fortran/openmp_version-2.f90 index b2d1d261f27..62712c7d206 100644 --- a/libgomp/testsuite/libgomp.fortran/openmp_version-2.f90 +++ b/libgomp/testsuite/libgomp.fortran/openmp_version-2.f90 @@ -4,6 +4,6 @@ program main use omp_lib implicit none - if (openmp_version .ne. 201107) call abort; + if (openmp_version .ne. 201307) call abort; end program main diff --git a/libgomp/testsuite/libgomp.fortran/procptr1.f90 b/libgomp/testsuite/libgomp.fortran/procptr1.f90 new file mode 100644 index 00000000000..4187739826f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/procptr1.f90 @@ -0,0 +1,42 @@ +! { dg-do run } + interface + integer function foo () + end function + integer function bar () + end function + integer function baz () + end function + end interface + procedure(foo), pointer :: ptr + integer :: i + ptr => foo +!$omp parallel shared (ptr) + if (ptr () /= 1) call abort +!$omp end parallel + ptr => bar +!$omp parallel firstprivate (ptr) + if (ptr () /= 2) call abort +!$omp end parallel +!$omp parallel sections lastprivate (ptr) +!$omp section + ptr => foo + if (ptr () /= 1) call abort +!$omp section + ptr => bar + if (ptr () /= 2) call abort +!$omp section + ptr => baz + if (ptr () /= 3) call abort +!$omp end parallel sections + if (ptr () /= 3) call abort + if (.not.associated (ptr, baz)) call abort +end +integer function foo () + foo = 1 +end function +integer function bar () + bar = 2 +end function +integer function baz () + baz = 3 +end function diff --git a/libgomp/testsuite/libgomp.fortran/simd1.f90 b/libgomp/testsuite/libgomp.fortran/simd1.f90 new file mode 100644 index 00000000000..b97d27f8dc5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd1.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + type dt + integer :: x = 0 + end type + type (dt) :: t + integer :: i, j, k, l, r, s, a(30) + integer, target :: q(30) + integer, pointer :: p(:) + !$omp declare reduction (foo : integer : & + !$omp & omp_out = omp_out + omp_in) initializer (omp_priv = 0) + !$omp declare reduction (+ : dt : omp_out%x = omp_out%x & + !$omp & + omp_in%x) + a(:) = 1 + q(:) = 1 + p => q + r = 0 + j = 10 + k = 20 + s = 0 + !$omp simd safelen (8) reduction(+:r, t) linear(j, k : 2) & + !$omp& private (l) aligned(p : 4) reduction(foo:s) + do i = 1, 30 + l = j + k + a(i) + p(i) + r = r + l + j = j + 2 + k = k + 2 + s = s + l + t%x = t%x + l + end do + if (r.ne.2700.or.j.ne.70.or.k.ne.80.or.s.ne.2700) call abort + if (t%x.ne.2700) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/simd2.f90 b/libgomp/testsuite/libgomp.fortran/simd2.f90 new file mode 100644 index 00000000000..9b90bcdd019 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd2.f90 @@ -0,0 +1,101 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + integer :: a(1024), b(1024), k, m, i, s, t + k = 4 + m = 2 + t = 1 + do i = 1, 1024 + a(i) = i - 513 + b(i) = modulo (i - 52, 39) + if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39 + end do + s = foo (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = bar (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = baz (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort +contains + function foo (p) + integer :: p(1024), u, v, i, s, foo + s = 0 + !$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) + do i = 1, 1024 + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end simd + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + foo = s + end function foo + function bar (p) + integer :: p(1024), u, v, i, s, bar + s = 0 + !$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end simd + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + bar = s + end function bar + function baz (p) + integer :: p(1024), u, v, i, s, baz + s = 0 + !$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) & + !$omp & linear(i : t) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + baz = s + end function baz +end diff --git a/libgomp/testsuite/libgomp.fortran/simd3.f90 b/libgomp/testsuite/libgomp.fortran/simd3.f90 new file mode 100644 index 00000000000..df9f4cac3fe --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd3.f90 @@ -0,0 +1,109 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + integer :: a(1024), b(1024), k, m, i, s, t + k = 4 + m = 2 + t = 1 + do i = 1, 1024 + a(i) = i - 513 + b(i) = modulo (i - 52, 39) + if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39 + end do + s = foo (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = bar (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = baz (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort +contains + function foo (p) + integer :: p(1024), u, v, i, s, foo + s = 0 + !$omp parallel + !$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) & + !$omp & schedule (static, 32) + do i = 1, 1024 + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end do simd + !$omp end parallel + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + foo = s + end function foo + function bar (p) + integer :: p(1024), u, v, i, s, bar + s = 0 + !$omp parallel + !$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) & + !$omp & schedule (dynamic, 32) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end do simd + !$omp endparallel + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + bar = s + end function bar + function baz (p) + integer :: p(1024), u, v, i, s, baz + s = 0 + !$omp parallel + !$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) & + !$omp & linear(i : t) schedule (static, 8) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end parallel + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + baz = s + end function baz +end diff --git a/libgomp/testsuite/libgomp.fortran/simd4.f90 b/libgomp/testsuite/libgomp.fortran/simd4.f90 new file mode 100644 index 00000000000..a5b8ba0babd --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd4.f90 @@ -0,0 +1,103 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + integer :: a(1024), b(1024), k, m, i, s, t + k = 4 + m = 2 + t = 1 + do i = 1, 1024 + a(i) = i - 513 + b(i) = modulo (i - 52, 39) + if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39 + end do + s = foo (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = bar (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + a(i) = i - 513 + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort + k = 4 + m = 2 + t = 1 + s = baz (b) + do i = 1, 1024 + if (a(i).ne.((i - 513) * b(i))) call abort + if (i.lt.52.and.modulo (i - 52, 39).ne.0) then + if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort + else + if (b(i).ne.(modulo (i - 52, 39))) call abort + end if + end do + if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort +contains + function foo (p) + integer :: p(1024), u, v, i, s, foo + s = 0 + !$omp parallel do simd linear(k : m + 1) reduction(+: s) & + !$omp & lastprivate(u, v) schedule (static, 32) + do i = 1, 1024 + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp end parallel do simd + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + foo = s + end function foo + function bar (p) + integer :: p(1024), u, v, i, s, bar + s = 0 + !$omp parallel do simd linear(k : m + 1) reduction(+: s) & + !$omp & lastprivate(u, v) schedule (dynamic, 32) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + !$omp endparalleldosimd + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + bar = s + end function bar + function baz (p) + integer :: p(1024), u, v, i, s, baz + s = 0 + !$omp parallel do simd linear(k : m + 1) reduction(+: s) & + !$omp & lastprivate(u, v) linear(i : t) schedule (static, 8) + do i = 1, 1024, t + a(i) = a(i) * p(i) + u = p(i) + k + k = k + m + 1 + v = p(i) + k + s = s + p(i) + k + end do + if (i.ne.1025) call abort + if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort + baz = s + end function baz +end diff --git a/libgomp/testsuite/libgomp.fortran/simd5.f90 b/libgomp/testsuite/libgomp.fortran/simd5.f90 new file mode 100644 index 00000000000..7a5efecac06 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd5.f90 @@ -0,0 +1,124 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + integer :: i, j, b, c + c = 0 + i = 4 + j = 4 + b = 7 +!$omp simd linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + b = b + 2 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + b = b + 3 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(i) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + b = b + 2 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(i:4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + b = b + 3 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp simd collapse(2) linear(b:2) reduction(+:c) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + b = b + 2 + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd collapse(2) linear(b:2) reduction(+:c) lastprivate (i, j) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + b = b + 2 + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + b = b + 2 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + b = b + 3 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(i) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + b = b + 2 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(i:4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + b = b + 3 + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) reduction(+:c) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + b = b + 2 + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) & +!$omp & reduction(+:c) lastprivate (i, j) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + b = b + 2 + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/simd6.f90 b/libgomp/testsuite/libgomp.fortran/simd6.f90 new file mode 100644 index 00000000000..881a8fb8db4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd6.f90 @@ -0,0 +1,135 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + + interface + subroutine foo (b, i, j, x) + integer, intent (inout) :: b + integer, intent (in) :: i, j, x + end subroutine + end interface + integer :: i, j, b, c + c = 0 + i = 4 + j = 4 + b = 7 +!$omp simd linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + call foo (b, i, j, 2) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + call foo (b, i, j, 3) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(i) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + call foo (b, i, j, 2) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd linear(i:4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + call foo (b, i, j, 3) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp simd collapse(2) linear(b:2) reduction(+:c) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + call foo (b, i, j, 2) + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp simd collapse(2) linear(b:2) reduction(+:c) lastprivate (i, j) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + call foo (b, i, j, 2) + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + call foo (b, i, j, 2) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + call foo (b, i, j, 3) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(i) linear(b:2) reduction(+:c) + do i = 0, 63 + c = c + b - (7 + 2 * i) + call foo (b, i, j, 2) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) linear(i:4) linear(b:3) reduction(+:c) + do i = 0, 63, 4 + c = c + b - (7 + i / 4 * 3) + call foo (b, i, j, 3) + end do + if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) reduction(+:c) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + call foo (b, i, j, 2) + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort + i = 4 + j = 4 + b = 7 +!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) & +!$omp & reduction(+:c) lastprivate (i, j) + do i = 0, 7 + do j = 0, 7 + c = c + b - (7 + 2 * j + 2 * 8 * i) + call foo (b, i, j, 2) + end do + end do + if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort +end +subroutine foo (b, i, j, x) + integer, intent (inout) :: b + integer, intent (in) :: i, j, x + b = b + (i - i) + (j - j) + x +end subroutine diff --git a/libgomp/testsuite/libgomp.fortran/simd7.f90 b/libgomp/testsuite/libgomp.fortran/simd7.f90 new file mode 100644 index 00000000000..b0473faa9e5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/simd7.f90 @@ -0,0 +1,172 @@ +! { dg-do run } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + +subroutine foo (d, e, f, g, m, n) + integer :: i, j, b(2:9), c(3:n), d(:), e(2:n), f(2:,3:), n + integer, allocatable :: g(:), h(:), k, m + logical :: l + l = .false. + allocate (h(2:7)) + i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m = 15 +!$omp simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5)linear(g:6) & +!$omp & linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) + do i = 0, 63 + l = l .or. .not.allocated (g) .or. .not.allocated (h) + l = l .or. .not.allocated (k) .or. .not.allocated (m) + l = l .or. any (b /= 7 + i) .or. any (c /= 8 + 2 * i) + l = l .or. any (d /= 9 + 3 * i) .or. any (e /= 10 + 4 * i) + l = l .or. any (f /= 11 + 5 * i) .or. any (g /= 12 + 6 * i) + l = l .or. any (h /= 13 + 7 * i) .or. (k /= 14 + 8 * i) + l = l .or. (m /= 15 + 9 * i) + l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9) + l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n) + l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17) + l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n) + l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3) + l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5) + l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10) + l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7) + b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6 + h = h + 7; k = k + 8; m = m + 9 + end do + if (l .or. i /= 64) call abort + if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort + if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort + if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort + if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort + if (m /= 15 + 9 * 64) call abort + if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort + if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort + if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort + if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort + if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort + if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort + if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort + if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort + i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m = 15 +!$omp simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5)linear(g:6) & +!$omp & linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) collapse(2) + do i = 0, 7 + do j = 0, 7 + l = l .or. .not.allocated (g) .or. .not.allocated (h) + l = l .or. .not.allocated (k) .or. .not.allocated (m) + l = l .or. any (b /= 7 + (8 * i + j)) .or. any (c /= 8 + 2 * (8 * i + j)) + l = l .or. any (d /= 9 + 3 * (8 * i + j)) .or. any (e /= 10 + 4 * (8 * i + j)) + l = l .or. any (f /= 11 + 5 * (8 * i + j)) .or. any (g /= 12 + 6 * (8 * i + j)) + l = l .or. any (h /= 13 + 7 * (8 * i + j)) .or. (k /= 14 + 8 * (8 * i + j)) + l = l .or. (m /= 15 + 9 * (8 * i + j)) + l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9) + l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n) + l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17) + l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n) + l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3) + l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5) + l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10) + l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7) + b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6 + h = h + 7; k = k + 8; m = m + 9 + end do + end do + if (l .or. i /= 8 .or. j /= 8) call abort + if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort + if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort + if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort + if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort + if (m /= 15 + 9 * 64) call abort + if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort + if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort + if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort + if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort + if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort + if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort + if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort + if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort + i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m = 15 +!$omp parallel do simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5) & +!$omp & linear(g:6)linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) + do i = 0, 63 + l = l .or. .not.allocated (g) .or. .not.allocated (h) + l = l .or. .not.allocated (k) .or. .not.allocated (m) + l = l .or. any (b /= 7 + i) .or. any (c /= 8 + 2 * i) + l = l .or. any (d /= 9 + 3 * i) .or. any (e /= 10 + 4 * i) + l = l .or. any (f /= 11 + 5 * i) .or. any (g /= 12 + 6 * i) + l = l .or. any (h /= 13 + 7 * i) .or. (k /= 14 + 8 * i) + l = l .or. (m /= 15 + 9 * i) + l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9) + l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n) + l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17) + l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n) + l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3) + l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5) + l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10) + l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7) + b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6 + h = h + 7; k = k + 8; m = m + 9 + end do + if (l .or. i /= 64) call abort + if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort + if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort + if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort + if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort + if (m /= 15 + 9 * 64) call abort + if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort + if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort + if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort + if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort + if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort + if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort + if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort + if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort + i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m = 15 +!$omp parallel do simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5) & +!$omp & linear(g:6)linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) collapse(2) + do i = 0, 7 + do j = 0, 7 + l = l .or. .not.allocated (g) .or. .not.allocated (h) + l = l .or. .not.allocated (k) .or. .not.allocated (m) + l = l .or. any (b /= 7 + (8 * i + j)) .or. any (c /= 8 + 2 * (8 * i + j)) + l = l .or. any (d /= 9 + 3 * (8 * i + j)) .or. any (e /= 10 + 4 * (8 * i + j)) + l = l .or. any (f /= 11 + 5 * (8 * i + j)) .or. any (g /= 12 + 6 * (8 * i + j)) + l = l .or. any (h /= 13 + 7 * (8 * i + j)) .or. (k /= 14 + 8 * (8 * i + j)) + l = l .or. (m /= 15 + 9 * (8 * i + j)) + l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9) + l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n) + l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17) + l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n) + l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3) + l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5) + l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10) + l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7) + b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6 + h = h + 7; k = k + 8; m = m + 9 + end do + end do + if (l .or. i /= 8 .or. j /= 8) call abort + if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort + if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort + if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort + if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort + if (m /= 15 + 9 * 64) call abort + if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort + if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort + if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort + if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort + if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort + if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort + if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort + if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort +end subroutine + + interface + subroutine foo (d, e, f, g, m, n) + integer :: d(:), e(2:n), f(2:,3:), n + integer, allocatable :: g(:), m + end subroutine + end interface + integer, parameter :: n = 8 + integer :: d(2:18), e(3:n+1), f(5:6,7:9) + integer, allocatable :: g(:), m + allocate (g(7:10)) + call foo (d, e, f, g, m, n) +end diff --git a/libgomp/testsuite/libgomp.fortran/target1.f90 b/libgomp/testsuite/libgomp.fortran/target1.f90 new file mode 100644 index 00000000000..c70daace497 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target1.f90 @@ -0,0 +1,58 @@ +! { dg-do run } + +module target1 +contains + subroutine foo (p, v, w, n) + double precision, pointer :: p(:), v(:), w(:) + double precision :: q(n) + integer :: i, n + !$omp target if (n > 256) map (to: v(1:n), w(:n)) map (from: p(1:n), q) + !$omp parallel do simd + do i = 1, n + p(i) = v(i) * w(i) + q(i) = p(i) + end do + !$omp end target + if (any (p /= q)) call abort + do i = 1, n + if (p(i) /= i * iand (i, 63)) call abort + end do + !$omp target data if (n > 256) map (to: v(1:n), w) map (from: p, q) + !$omp target if (n > 256) + do i = 1, n + p(i) = 1.0 + q(i) = 2.0 + end do + !$omp end target + !$omp target if (n > 256) + do i = 1, n + p(i) = p(i) + v(i) * w(i) + q(i) = q(i) + v(i) * w(i) + end do + !$omp end target + !$omp target if (n > 256) + !$omp teams distribute parallel do simd linear(i:1) + do i = 1, n + p(i) = p(i) + 2.0 + q(i) = q(i) + 3.0 + end do + !$omp end target + !$omp end target data + if (any (p + 2.0 /= q)) call abort + end subroutine +end module target1 + use target1, only : foo + integer :: n, i + double precision, pointer :: p(:), v(:), w(:) + n = 10000 + allocate (p(n), v(n), w(n)) + do i = 1, n + v(i) = i + w(i) = iand (i, 63) + end do + call foo (p, v, w, n) + do i = 1, n + if (p(i) /= i * iand (i, 63) + 3) call abort + end do + deallocate (p, v, w) +end diff --git a/libgomp/testsuite/libgomp.fortran/target2.f90 b/libgomp/testsuite/libgomp.fortran/target2.f90 new file mode 100644 index 00000000000..42f704f2bb3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target2.f90 @@ -0,0 +1,96 @@ +! { dg-do run } +! { dg-options "-fopenmp -ffree-line-length-160" } + +module target2 +contains + subroutine foo (a, b, c, d, e, f, g, n, q) + integer :: n, q + integer :: a, b(3:n), c(5:), d(2:*), e(:,:) + integer, pointer :: f, g(:) + integer :: h, i(3:n) + integer, pointer :: j, k(:) + logical :: r + allocate (j, k(4:n)) + h = 14 + i = 15 + j = 16 + k = 17 + !$omp target map (to: a, b, c, d(2:n+1), e, f, g, h, i, j, k, n) map (from: r) + r = a /= 7 + r = r .or. (any (b /= 8)) .or. (lbound (b, 1) /= 3) .or. (ubound (b, 1) /= n) + r = r .or. (any (c /= 9)) .or. (lbound (c, 1) /= 5) .or. (ubound (c, 1) /= n + 4) + r = r .or. (any (d(2:n+1) /= 10)) .or. (lbound (d, 1) /= 2) + r = r .or. (any (e /= 11)) .or. (lbound (e, 1) /= 1) .or. (ubound (e, 1) /= 2) + r = r .or. (lbound (e, 2) /= 1) .or. (ubound (e, 2) /= 2) + r = r .or. (f /= 12) + r = r .or. (any (g /= 13)) .or. (lbound (g, 1) /= 3) .or. (ubound (g, 1) /= n) + r = r .or. (h /= 14) + r = r .or. (any (i /= 15)) .or. (lbound (i, 1) /= 3) .or. (ubound (i, 1) /= n) + r = r .or. (j /= 16) + r = r .or. (any (k /= 17)) .or. (lbound (k, 1) /= 4) .or. (ubound (k, 1) /= n) + !$omp end target + if (r) call abort + !$omp target map (to: b(3:n), c(5:n+4), d(2:n+1), e(1:,:2), g(3:n), i(3:n), k(4:n), n) map (from: r) + r = (any (b /= 8)) .or. (lbound (b, 1) /= 3) .or. (ubound (b, 1) /= n) + r = r .or. (any (c /= 9)) .or. (lbound (c, 1) /= 5) .or. (ubound (c, 1) /= n + 4) + r = r .or. (any (d(2:n+1) /= 10)) .or. (lbound (d, 1) /= 2) + r = r .or. (any (e /= 11)) .or. (lbound (e, 1) /= 1) .or. (ubound (e, 1) /= 2) + r = r .or. (lbound (e, 2) /= 1) .or. (ubound (e, 2) /= 2) + r = r .or. (any (g /= 13)) .or. (lbound (g, 1) /= 3) .or. (ubound (g, 1) /= n) + r = r .or. (any (i /= 15)) .or. (lbound (i, 1) /= 3) .or. (ubound (i, 1) /= n) + r = r .or. (any (k /= 17)) .or. (lbound (k, 1) /= 4) .or. (ubound (k, 1) /= n) + !$omp end target + if (r) call abort + !$omp target map (to: b(5:n-2), c(7:n), d(4:n-2), e(1:,2:), g(5:n-3), i(6:n-4), k(5:n-5), n) map (from: r) + r = (any (b(5:n-2) /= 8)) .or. (lbound (b, 1) /= 3) .or. (ubound (b, 1) /= n) + r = r .or. (any (c(7:n) /= 9)) .or. (lbound (c, 1) /= 5) .or. (ubound (c, 1) /= n + 4) + r = r .or. (any (d(4:n-2) /= 10)) .or. (lbound (d, 1) /= 2) + r = r .or. (any (e(1:,2:) /= 11)) .or. (lbound (e, 1) /= 1) .or. (ubound (e, 1) /= 2) + r = r .or. (lbound (e, 2) /= 1) .or. (ubound (e, 2) /= 2) + r = r .or. (any (g(5:n-3) /= 13)) .or. (lbound (g, 1) /= 3) .or. (ubound (g, 1) /= n) + r = r .or. (any (i(6:n-4) /= 15)) .or. (lbound (i, 1) /= 3) .or. (ubound (i, 1) /= n) + r = r .or. (any (k(5:n-5) /= 17)) .or. (lbound (k, 1) /= 4) .or. (ubound (k, 1) /= n) + !$omp end target + !$omp target map (to: b(q+5:n-2+q), c(q+7:q+n), d(q+4:q+n-2), e(1:q+2,2:q+2), g(5+q:n-3+q), & + !$omp & i(6+q:n-4+q), k(5+q:n-5+q), n) map (from: r) + r = (any (b(5:n-2) /= 8)) .or. (lbound (b, 1) /= 3) .or. (ubound (b, 1) /= n) + r = r .or. (any (c(7:n) /= 9)) .or. (lbound (c, 1) /= 5) .or. (ubound (c, 1) /= n + 4) + r = r .or. (any (d(4:n-2) /= 10)) .or. (lbound (d, 1) /= 2) + r = r .or. (any (e(1:,2:) /= 11)) .or. (lbound (e, 1) /= 1) .or. (ubound (e, 1) /= 2) + r = r .or. (lbound (e, 2) /= 1) .or. (ubound (e, 2) /= 2) + r = r .or. (any (g(5:n-3) /= 13)) .or. (lbound (g, 1) /= 3) .or. (ubound (g, 1) /= n) + r = r .or. (any (i(6:n-4) /= 15)) .or. (lbound (i, 1) /= 3) .or. (ubound (i, 1) /= n) + r = r .or. (any (k(5:n-5) /= 17)) .or. (lbound (k, 1) /= 4) .or. (ubound (k, 1) /= n) + !$omp end target + if (r) call abort + !$omp target map (to: d(2:n+1), n) + r = a /= 7 + r = r .or. (any (b /= 8)) .or. (lbound (b, 1) /= 3) .or. (ubound (b, 1) /= n) + r = r .or. (any (c /= 9)) .or. (lbound (c, 1) /= 5) .or. (ubound (c, 1) /= n + 4) + r = r .or. (any (d(2:n+1) /= 10)) .or. (lbound (d, 1) /= 2) + r = r .or. (any (e /= 11)) .or. (lbound (e, 1) /= 1) .or. (ubound (e, 1) /= 2) + r = r .or. (lbound (e, 2) /= 1) .or. (ubound (e, 2) /= 2) + r = r .or. (f /= 12) + r = r .or. (any (g /= 13)) .or. (lbound (g, 1) /= 3) .or. (ubound (g, 1) /= n) + r = r .or. (h /= 14) + r = r .or. (any (i /= 15)) .or. (lbound (i, 1) /= 3) .or. (ubound (i, 1) /= n) + r = r .or. (j /= 16) + r = r .or. (any (k /= 17)) .or. (lbound (k, 1) /= 4) .or. (ubound (k, 1) /= n) + !$omp end target + if (r) call abort + end subroutine foo +end module target2 + use target2, only : foo + integer, parameter :: n = 15, q = 0 + integer :: a, b(2:n-1), c(n), d(n), e(3:4, 3:4) + integer, pointer :: f, g(:) + allocate (f, g(3:n)) + a = 7 + b = 8 + c = 9 + d = 10 + e = 11 + f = 12 + g = 13 + call foo (a, b, c, d, e, f, g, n, q) +end diff --git a/libgomp/testsuite/libgomp.fortran/target3.f90 b/libgomp/testsuite/libgomp.fortran/target3.f90 new file mode 100644 index 00000000000..1f197acdef7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target3.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + +module target3 +contains + subroutine foo (f, g) + integer :: n + integer, pointer :: f, g(:) + integer, pointer :: j, k(:) + logical :: r + nullify (j) + k => null () + !$omp target map (tofrom: f, g, j, k) map (from: r) + r = associated (f) .or. associated (g) + r = r .or. associated (j) .or. associated (k) + !$omp end target + if (r) call abort + !$omp target + r = associated (f) .or. associated (g) + r = r .or. associated (j) .or. associated (k) + !$omp end target + if (r) call abort + end subroutine foo +end module target3 + use target3, only : foo + integer, pointer :: f, g(:) + f => null () + nullify (g) + call foo (f, g) +end diff --git a/libgomp/testsuite/libgomp.fortran/target4.f90 b/libgomp/testsuite/libgomp.fortran/target4.f90 new file mode 100644 index 00000000000..aa2f0a5ac19 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target4.f90 @@ -0,0 +1,48 @@ +! { dg-do run } + +module target4 +contains + subroutine foo (a,m,n) + integer :: m,n,i,j + double precision :: a(m, n), t + !$omp target data map(a) map(to: m, n) + do i=1,n + t = 0.0d0 + !$omp target + !$omp parallel do reduction(+:t) + do j=1,m + t = t + a(j,i) * a(j,i) + end do + !$omp end target + t = 2.0d0 * t + !$omp target + !$omp parallel do + do j=1,m + a(j,i) = a(j,i) * t + end do + !$omp end target + end do + !$omp end target data + end subroutine foo +end module target4 + use target4, only : foo + integer :: i, j + double precision :: a(8, 9), res(8, 9) + do i = 1, 8 + do j = 1, 9 + a(i, j) = i + j + end do + end do + call foo (a, 8, 9) + res = reshape ((/ 1136.0d0, 1704.0d0, 2272.0d0, 2840.0d0, 3408.0d0, 3976.0d0, & +& 4544.0d0, 5112.0d0, 2280.0d0, 3040.0d0, 3800.0d0, 4560.0d0, 5320.0d0, 6080.0d0, & +& 6840.0d0, 7600.0d0, 3936.0d0, 4920.0d0, 5904.0d0, 6888.0d0, 7872.0d0, 8856.0d0, & +& 9840.0d0, 10824.0d0, 6200.0d0, 7440.0d0, 8680.0d0, 9920.0d0, 11160.0d0, 12400.0d0, & +& 13640.0d0, 14880.0d0, 9168.0d0, 10696.0d0, 12224.0d0, 13752.0d0, 15280.0d0, 16808.0d0, & +& 18336.0d0, 19864.0d0, 12936.0d0, 14784.0d0, 16632.0d0, 18480.0d0, 20328.0d0, 22176.0d0, & +& 24024.0d0, 25872.0d0, 17600.0d0, 19800.0d0, 22000.0d0, 24200.0d0, 26400.0d0, 28600.0d0, & +& 30800.0d0, 33000.0d0, 23256.0d0, 25840.0d0, 28424.0d0, 31008.0d0, 33592.0d0, 36176.0d0, & +& 38760.0d0, 41344.0d0, 30000.0d0, 33000.0d0, 36000.0d0, 39000.0d0, 42000.0d0, 45000.0d0, & +& 48000.0d0, 51000.0d0 /), (/ 8, 9 /)) + if (any (a /= res)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/target5.f90 b/libgomp/testsuite/libgomp.fortran/target5.f90 new file mode 100644 index 00000000000..c46faf226f6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target5.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + + integer :: r + r = 0 + call foo (r) + if (r /= 11) call abort +contains + subroutine foo (r) + integer :: i, r + !$omp parallel + !$omp single + !$omp target teams distribute parallel do reduction (+: r) + do i = 1, 10 + r = r + 1 + end do + r = r + 1 + !$omp end single + !$omp end parallel + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/target6.f90 b/libgomp/testsuite/libgomp.fortran/target6.f90 new file mode 100644 index 00000000000..13f5a52edd2 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target6.f90 @@ -0,0 +1,50 @@ +! { dg-do run } + +module target6 +contains + subroutine foo (p, v, w, n) + double precision, pointer :: p(:), v(:), w(:) + double precision :: q(n) + integer :: i, n + !$omp target data if (n > 256) map (to: v(1:n), w(:n)) map (from: p(1:n), q) + !$omp target if (n > 256) + !$omp parallel do simd + do i = 1, n + p(i) = v(i) * w(i) + q(i) = p(i) + end do + !$omp end target + !$omp target update if (n > 256) from (p) + do i = 1, n + if (p(i) /= i * iand (i, 63)) call abort + v(i) = v(i) + 1 + end do + !$omp target update if (n > 256) to (v(1:n)) + !$omp target if (n > 256) + !$omp parallel do simd + do i = 1, n + p(i) = v(i) * w(i) + end do + !$omp end target + !$omp end target data + do i = 1, n + if (q(i) /= (v(i) - 1) * w(i)) call abort + if (p(i) /= q(i) + w(i)) call abort + end do + end subroutine +end module target6 + use target6, only : foo + integer :: n, i + double precision, pointer :: p(:), v(:), w(:) + n = 10000 + allocate (p(n), v(n), w(n)) + do i = 1, n + v(i) = i + w(i) = iand (i, 63) + end do + call foo (p, v, w, n) + do i = 1, n + if (p(i) /= (i + 1) * iand (i, 63)) call abort + end do + deallocate (p, v, w) +end diff --git a/libgomp/testsuite/libgomp.fortran/target7.f90 b/libgomp/testsuite/libgomp.fortran/target7.f90 new file mode 100644 index 00000000000..0c977c44ae1 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target7.f90 @@ -0,0 +1,38 @@ +! { dg-do run } + + interface + real function foo (x) + !$omp declare target + real, intent(in) :: x + end function foo + end interface + integer, parameter :: n = 1000 + integer, parameter :: c = 100 + integer :: i, j + real :: a(n) + do i = 1, n + a(i) = i + end do + !$omp parallel + !$omp single + do i = 1, n, c + !$omp task shared(a) + !$omp target map(a(i:i+c-1)) + !$omp parallel do + do j = i, i + c - 1 + a(j) = foo (a(j)) + end do + !$omp end target + !$omp end task + end do + !$omp end single + !$omp end parallel + do i = 1, n + if (a(i) /= i + 1) call abort + end do +end +real function foo (x) + !$omp declare target + real, intent(in) :: x + foo = x + 1 +end function foo diff --git a/libgomp/testsuite/libgomp.fortran/target8.f90 b/libgomp/testsuite/libgomp.fortran/target8.f90 new file mode 100644 index 00000000000..0564e90e08e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target8.f90 @@ -0,0 +1,33 @@ +! { dg-do run } + + integer, parameter :: n = 1000 + integer, parameter :: c = 100 + integer :: i, j + real :: a(n) + do i = 1, n + a(i) = i + end do + !$omp parallel + !$omp single + do i = 1, n, c + !$omp task shared(a) + !$omp target map(a(i:i+c-1)) + !$omp parallel do + do j = i, i + c - 1 + a(j) = foo (a(j)) + end do + !$omp end target + !$omp end task + end do + !$omp end single + !$omp end parallel + do i = 1, n + if (a(i) /= i + 1) call abort + end do +contains + real function foo (x) + !$omp declare target + real, intent(in) :: x + foo = x + 1 + end function foo +end diff --git a/libgomp/testsuite/libgomp.fortran/taskgroup1.f90 b/libgomp/testsuite/libgomp.fortran/taskgroup1.f90 new file mode 100644 index 00000000000..018d3e83b92 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/taskgroup1.f90 @@ -0,0 +1,80 @@ + integer :: v(16), i + do i = 1, 16 + v(i) = i + end do + + !$omp parallel num_threads (4) + !$omp single + !$omp taskgroup + do i = 1, 16, 2 + !$omp task + !$omp task + v(i) = v(i) + 1 + !$omp end task + !$omp task + v(i + 1) = v(i + 1) + 1 + !$omp end task + !$omp end task + end do + !$omp end taskgroup + do i = 1, 16 + if (v(i).ne.(i + 1)) call abort + end do + !$omp taskgroup + do i = 1, 16, 2 + !$omp task + !$omp task + v(i) = v(i) + 1 + !$omp endtask + !$omp task + v(i + 1) = v(i + 1) + 1 + !$omp endtask + !$omp taskwait + !$omp endtask + end do + !$omp endtaskgroup + do i = 1, 16 + if (v(i).ne.(i + 2)) call abort + end do + !$omp taskgroup + do i = 1, 16, 2 + !$omp task + !$omp task + v(i) = v(i) + 1 + !$omp end task + v(i + 1) = v(i + 1) + 1 + !$omp end task + end do + !$omp taskwait + do i = 1, 16, 2 + !$omp task + v(i + 1) = v(i + 1) + 1 + !$omp end task + end do + !$omp end taskgroup + do i = 1, 16, 2 + if (v(i).ne.(i + 3)) call abort + if (v(i + 1).ne.(i + 5)) call abort + end do + !$omp taskgroup + do i = 1, 16, 2 + !$omp taskgroup + !$omp task + v(i) = v(i) + 1 + !$omp end task + !$omp task + v(i + 1) = v(i + 1) + 1 + !$omp end task + !$omp end taskgroup + if (v(i).ne.(i + 4).or.v(i + 1).ne.(i + 6)) call abort + !$omp task + v(i) = v(i) + 1 + !$omp end task + end do + !$omp end taskgroup + do i = 1, 16 + if (v(i).ne.(i + 5)) call abort + end do + !$omp end single + !$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/udr1.f90 b/libgomp/testsuite/libgomp.fortran/udr1.f90 new file mode 100644 index 00000000000..5b8044fbe75 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr1.f90 @@ -0,0 +1,51 @@ +! { dg-do run } + +module udr1 + type dt + integer :: x = 7 + integer :: y = 9 + end type +end module udr1 + use udr1, only : dt +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) + integer :: i, j +!$omp declare reduction (bar : integer : & +!$omp & omp_out = omp_out + iand (omp_in, -4)) initializer (omp_priv = 3) + type (dt) :: d +!$omp declare reduction (+ : dt : omp_out%x = omp_out%x & +!$omp & + iand (omp_in%x, -8)) +!$omp declare reduction (foo : dt : omp_out%x = iand (omp_in%x, -8) & +!$omp & + omp_out%x) initializer (omp_priv = dt (5, 21)) + interface operator (+) + function notdefined(x, y) + use udr1, only : dt + type(dt), intent (in) :: x, y + type(dt) :: notdefined + end function + end interface + j = 0 +!$omp parallel do reduction (foo : j) + do i = 1, 100 + j = j + i + end do + if (j .ne. 5050) call abort + j = 3 +!$omp parallel do reduction (bar : j) + do i = 1, 100 + j = j + 4 * i + end do + if (j .ne. (5050 * 4 + 3)) call abort +!$omp parallel do reduction (+ : d) + do i = 1, 100 + if (d%y .ne. 9) call abort + d%x = d%x + 8 * i + end do + if (d%x .ne. (5050 * 8 + 7) .or. d%y .ne. 9) call abort + d = dt (5, 21) +!$omp parallel do reduction (foo : d) + do i = 1, 100 + if (d%y .ne. 21) call abort + d%x = d%x + 8 * i + end do + if (d%x .ne. (5050 * 8 + 5) .or. d%y .ne. 21) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr10.f90 b/libgomp/testsuite/libgomp.fortran/udr10.f90 new file mode 100644 index 00000000000..b64b4f48800 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr10.f90 @@ -0,0 +1,32 @@ +! { dg-do run } + +module udr10m + type dt + integer :: x = 0 + end type +!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in) +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) + interface operator(+) + module procedure addme + end interface + interface operator(.add.) + module procedure addme + end interface +contains + type(dt) function addme (x, y) + type (dt), intent (in) :: x, y + addme%x = x%x + y%x + end function addme +end module udr10m +program udr10 + use udr10m, only : operator(.localadd.) => operator(.add.), & +& operator(+), dl => dt + type(dl) :: j, k + integer :: i +!$omp parallel do reduction(+:j) reduction(.localadd.:k) + do i = 1, 100 + j = j .localadd. dl(i) + k = k + dl(i * 2) + end do + if (j%x /= 5050 .or. k%x /= 10100) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr11.f90 b/libgomp/testsuite/libgomp.fortran/udr11.f90 new file mode 100644 index 00000000000..61fb196105d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr11.f90 @@ -0,0 +1,95 @@ +! { dg-do run } + +module udr11 + type dt + integer :: x = 0 + end type +end module udr11 + use udr11, only : dt +!$omp declare reduction(+:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(-:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(*:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(.and.:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(.or.:dt:omp_out%x=omp_out%x+3*omp_in%x) +!$omp declare reduction(.eqv.:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(.neqv.:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(min:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(max:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(iand:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(ior:dt:omp_out%x=omp_out%x+omp_in%x) +!$omp declare reduction(ieor:dt:omp_out%x=omp_out%x+omp_in%x) + interface operator(.and.) + function addme1 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme1 + end function addme1 + end interface + interface operator(.or.) + function addme2 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme2 + end function addme2 + end interface + interface operator(.eqv.) + function addme3 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme3 + end function addme3 + end interface + interface operator(.neqv.) + function addme4 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme4 + end function addme4 + end interface + interface operator(+) + function addme5 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme5 + end function addme5 + end interface + interface operator(-) + function addme6 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme6 + end function addme6 + end interface + interface operator(*) + function addme7 (x, y) + use udr11, only : dt + type (dt), intent (in) :: x, y + type(dt) :: addme7 + end function addme7 + end interface + type(dt) :: j, k, l, m, n, o, p, q, r, s, t, u + integer :: i +!$omp parallel do reduction(.and.:j) reduction(.or.:k) & +!$omp & reduction(.eqv.:l) reduction(.neqv.:m) & +!$omp & reduction(min:n) reduction(max:o) & +!$omp & reduction(iand:p) reduction(ior:q) reduction (ieor:r) & +!$omp & reduction(+:s) reduction(-:t) reduction(*:u) + do i = 1, 100 + j%x = j%x + i + k%x = k%x + 2 * i + l%x = l%x + 3 * i + m%x = m%x + i + n%x = n%x + 2 * i + o%x = o%x + 3 * i + p%x = p%x + i + q%x = q%x + 2 * i + r%x = r%x + 3 * i + s%x = s%x + i + t%x = t%x + 2 * i + u%x = u%x + 3 * i + end do + if (j%x /= 5050 .or. k%x /= 30300 .or. l%x /= 15150) call abort + if (m%x /= 5050 .or. n%x /= 10100 .or. o%x /= 15150) call abort + if (p%x /= 5050 .or. q%x /= 10100 .or. r%x /= 15150) call abort + if (s%x /= 5050 .or. t%x /= 10100 .or. u%x /= 15150) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr12.f90 b/libgomp/testsuite/libgomp.fortran/udr12.f90 new file mode 100644 index 00000000000..601bca6a93e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr12.f90 @@ -0,0 +1,76 @@ +! { dg-do run } + + interface + elemental subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + end subroutine + elemental function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + end function + end interface +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + interface + elemental function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + end function + elemental subroutine sub2 (x, y) + integer, intent(in) :: y + integer, intent(inout) :: x + end subroutine + end interface + integer :: a(10), b, r + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (foo : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 2 * r) .or. b /= 3 * r) call abort + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (bar : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 4 * r) .or. b /= 6 * r) call abort + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (baz : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 2 * r) .or. b /= 3 * r) call abort +end +elemental function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + fn1 = x + 2 * y +end function +elemental subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + x = 0 +end subroutine +elemental function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + fn2 = x +end function +elemental subroutine sub2 (x, y) + integer, intent(inout) :: x + integer, intent(in) :: y + x = x + y +end subroutine diff --git a/libgomp/testsuite/libgomp.fortran/udr13.f90 b/libgomp/testsuite/libgomp.fortran/udr13.f90 new file mode 100644 index 00000000000..0da1da4bc65 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr13.f90 @@ -0,0 +1,106 @@ +! { dg-do run } + + interface + subroutine sub1 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + end subroutine + function fn2 (x, m1, m2, n1, n2) + integer, intent(in) :: x(:,:), m1, m2, n1, n2 + integer :: fn2(m1:m2,n1:n2) + end function + subroutine sub3 (x, y) + integer, allocatable, intent(in) :: y(:,:) + integer, allocatable, intent(inout) :: x(:,:) + end subroutine + end interface +!$omp declare reduction (foo : integer : sub3 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn3 (omp_orig)) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in, & +!$omp & lbound (omp_out, 1), ubound (omp_out, 1))) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig, lbound (omp_priv, 1), & +!$omp ubound (omp_priv, 1), lbound (omp_priv, 2), ubound (omp_priv, 2))) + interface + function fn1 (x, y, m1, m2) + integer, intent(in) :: x(:), y(:), m1, m2 + integer :: fn1(m1:m2) + end function + subroutine sub2 (x, y) + integer, intent(in) :: y(:,:) + integer, intent(inout) :: x(:,:) + end subroutine + function fn3 (x) + integer, allocatable, intent(in) :: x(:,:) + integer, allocatable :: fn3(:,:) + end function + end interface + integer :: a(10), b(3:5,7:9), r + integer, allocatable :: c(:,:) + a(:) = 0 + r = 0 +!$omp parallel reduction (bar : a) reduction (+: r) + if (lbound (a, 1) /= 1 .or. ubound (a, 1) /= 10) call abort + a = a + 2 + r = r + 1 +!$omp end parallel + if (any (a /= 4 * r) ) call abort + b(:,:) = 0 + allocate (c (4:6,8:10)) + c(:,:) = 0 + r = 0 +!$omp parallel reduction (baz : b, c) reduction (+: r) + if (lbound (b, 1) /= 3 .or. ubound (b, 1) /= 5) call abort + if (lbound (b, 2) /= 7 .or. ubound (b, 2) /= 9) call abort + if (.not. allocated (c)) call abort + if (lbound (c, 1) /= 4 .or. ubound (c, 1) /= 6) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 10) call abort + b = b + 3 + c = c + 4 + r = r + 1 +!$omp end parallel + if (any (b /= 3 * r) .or. any (c /= 4 * r)) call abort + deallocate (c) + allocate (c (0:1,7:11)) + c(:,:) = 0 + r = 0 +!$omp parallel reduction (foo : c) reduction (+: r) + if (.not. allocated (c)) call abort + if (lbound (c, 1) /= 0 .or. ubound (c, 1) /= 1) call abort + if (lbound (c, 2) /= 7 .or. ubound (c, 2) /= 11) call abort + c = c + 5 + r = r + 1 +!$omp end parallel + if (any (c /= 10 * r)) call abort +end +function fn1 (x, y, m1, m2) + integer, intent(in) :: x(:), y(:), m1, m2 + integer :: fn1(m1:m2) + fn1 = x + 2 * y +end function +subroutine sub1 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + x = 0 +end subroutine +function fn2 (x, m1, m2, n1, n2) + integer, intent(in) :: x(:,:), m1, m2, n1, n2 + integer :: fn2(m1:m2,n1:n2) + fn2 = x +end function +subroutine sub2 (x, y) + integer, intent(inout) :: x(:,:) + integer, intent(in) :: y(:,:) + x = x + y +end subroutine +function fn3 (x) + integer, allocatable, intent(in) :: x(:,:) + integer, allocatable :: fn3(:,:) + fn3 = x +end function +subroutine sub3 (x, y) + integer, allocatable, intent(inout) :: x(:,:) + integer, allocatable, intent(in) :: y(:,:) + x = x + 2 * y +end subroutine diff --git a/libgomp/testsuite/libgomp.fortran/udr14.f90 b/libgomp/testsuite/libgomp.fortran/udr14.f90 new file mode 100644 index 00000000000..d6974585578 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr14.f90 @@ -0,0 +1,50 @@ +! { dg-do run } + + type dt + integer :: g + integer, allocatable :: h(:) + end type +!$omp declare reduction (baz : dt : bar (omp_out, omp_in)) & +!$omp & initializer (foo (omp_priv, omp_orig)) + integer :: r + type (dt), allocatable :: a(:) + allocate (a(7:8)) + a(:)%g = 0 + a(7)%h = (/ 0, 0, 0 /) + r = 0 +!$omp parallel reduction(+:r) reduction (baz:a) + if (.not.allocated (a)) call abort + if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) call abort + if (.not.allocated (a(7)%h)) call abort + if (allocated (a(8)%h)) call abort + if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) call abort + a(:)%g = a(:)%g + 2 + a(7)%h = a(7)%h + 3 + r = r + 1 +!$omp end parallel + if (.not.allocated (a)) call abort + if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) call abort + if (.not.allocated (a(7)%h)) call abort + if (allocated (a(8)%h)) call abort + if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) call abort + if (any (a(:)%g /= 2 * r) .or. any (a(7)%h(:) /= 3 * r)) call abort +contains + subroutine foo (x, y) + type (dt), allocatable :: x(:), y(:) + if (allocated (x) .neqv. allocated (y)) call abort + if (lbound (x, 1) /= lbound (y, 1)) call abort + if (ubound (x, 1) /= ubound (y, 1)) call abort + if (allocated (x(7)%h) .neqv. allocated (y(7)%h)) call abort + if (allocated (x(8)%h) .neqv. allocated (y(8)%h)) call abort + if (lbound (x(7)%h, 1) /= lbound (y(7)%h, 1)) call abort + if (ubound (x(7)%h, 1) /= ubound (y(7)%h, 1)) call abort + x(7)%g = 0 + x(7)%h = 0 + x(8)%g = 0 + end subroutine + subroutine bar (x, y) + type (dt), allocatable :: x(:), y(:) + x(:)%g = x(:)%g + y(:)%g + x(7)%h(:) = x(7)%h(:) + y(7)%h(:) + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/udr15.f90 b/libgomp/testsuite/libgomp.fortran/udr15.f90 new file mode 100644 index 00000000000..2d1169568dd --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr15.f90 @@ -0,0 +1,64 @@ +! { dg-do run } + +module udr15m1 + integer, parameter :: a = 6 + integer :: b +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) +!$omp declare reduction (.add. : integer : & +!$omp & omp_out = omp_out .add. f3 (omp_in, -4)) & +!$omp & initializer (s1 (omp_priv, omp_orig)) + interface operator (.add.) + module procedure f1 + end interface +contains + integer function f1 (x, y) + integer, intent (in) :: x, y + f1 = x + y + end function f1 + integer function f3 (x, y) + integer, intent (in) :: x, y + f3 = iand (x, y) + end function f3 + subroutine s1 (x, y) + integer, intent (in) :: y + integer, intent (out) :: x + x = 3 + end subroutine s1 +end module udr15m1 +module udr15m2 + use udr15m1, f4 => f1, f5 => f3, s2 => s1, operator (.addtwo.) => operator (.add.) + type dt + integer :: x + end type +!$omp declare reduction (+ : dt : omp_out = f6 (omp_out + omp_in)) & +!$omp & initializer (s3 (omp_priv)) + interface operator (+) + module procedure f2 + end interface +contains + type(dt) function f2 (x, y) + type(dt), intent (in) :: x, y + f2%x = x%x + y%x + end function f2 + type(dt) function f6 (x) + type(dt), intent (in) :: x + f6%x = x%x + end function f6 + subroutine s3 (x) + type(dt), intent (out) :: x + x = dt(0) + end subroutine +end module udr15m2 + use udr15m2, operator (.addthree.) => operator (.addtwo.), & + f7 => f4, f8 => f6, s4 => s3 + integer :: i, j + type(dt) :: d + j = 3 + d%x = 0 +!$omp parallel do reduction (.addthree.: j) reduction (+ : d) + do i = 1, 100 + j = j.addthree.iand (i, -4) + d = d + dt(i) + end do + if (d%x /= 5050 .or. j /= 4903) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr2.f90 b/libgomp/testsuite/libgomp.fortran/udr2.f90 new file mode 100644 index 00000000000..861a4b27022 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr2.f90 @@ -0,0 +1,51 @@ +! { dg-do run } + +module udr2 + type dt + integer :: x = 7 + integer :: y = 9 + end type +end module udr2 + use udr2, only : dt +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) + integer :: i, j(2:4,3:5) +!$omp declare reduction (bar : integer : & +!$omp & omp_out = omp_out + iand (omp_in, -4)) initializer (omp_priv = 3) + interface operator (+) + function notdefined(x, y) + use udr2, only : dt + type(dt), intent (in) :: x, y + type(dt) :: notdefined + end function + end interface + type (dt) :: d(2:4,3:5) +!$omp declare reduction (+ : dt : omp_out%x = omp_out%x & +!$omp & + iand (omp_in%x, -8)) +!$omp declare reduction (foo : dt : omp_out%x = iand (omp_in%x, -8) & +!$omp & + omp_out%x) initializer (omp_priv = dt (5, 21)) + j = 0 +!$omp parallel do reduction (foo : j) + do i = 1, 100 + j = j + i + end do + if (any(j .ne. 5050)) call abort + j = 3 +!$omp parallel do reduction (bar : j) + do i = 1, 100 + j = j + 4 * i + end do + if (any(j .ne. (5050 * 4 + 3))) call abort +!$omp parallel do reduction (+ : d) + do i = 1, 100 + if (any(d%y .ne. 9)) call abort + d%x = d%x + 8 * i + end do + if (any(d%x .ne. (5050 * 8 + 7)) .or. any(d%y .ne. 9)) call abort + d = dt (5, 21) +!$omp parallel do reduction (foo : d) + do i = 1, 100 + if (any(d%y .ne. 21)) call abort + d%x = d%x + 8 * i + end do + if (any(d%x .ne. (5050 * 8 + 5)) .or. any(d%y .ne. 21)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr3.f90 b/libgomp/testsuite/libgomp.fortran/udr3.f90 new file mode 100644 index 00000000000..258b6722000 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr3.f90 @@ -0,0 +1,38 @@ +! { dg-do run } + +!$omp declare reduction (foo : character(kind=1, len=*) & +!$omp & : omp_out = trim(omp_out) // omp_in) initializer (omp_priv = '') +!$omp declare reduction (bar : character(kind=1, len=:) & +!$omp & : omp_out = trim(omp_in) // omp_out) initializer (omp_priv = '') +!$omp declare reduction (baz : character(kind=1, len=1) & +!$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) & +!$omp & - ichar ('0'))) initializer (omp_priv = '0') +!$omp declare reduction (baz : character(kind=1, len=2) & +!$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) & +!$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + & +!$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00') + character(kind=1, len=64) :: c, d + character(kind = 1, len=1) :: e + character(kind = 1, len=1+1) :: f + integer :: i + c = '' + d = '' + e = '0' + f = '00' +!$omp parallel do reduction (foo : c) reduction (bar : d) & +!$omp & reduction (baz : e, f) + do i = 1, 64 + c = trim(c) // char (ichar ('0') + i) + d = char (ichar ('0') + i) // d + e = char (ichar (e) + mod (i, 3)) + f = char (ichar (f(1:1)) + mod (i, 2)) & +& // char (ichar (f(2:2)) + mod (i, 3)) + end do + do i = 1, 64 + if (index (c, char (ichar ('0') + i)) .eq. 0) call abort + if (index (d, char (ichar ('0') + i)) .eq. 0) call abort + end do + if (e.ne.char (ichar ('0') + 64)) call abort + if (f(1:1).ne.char (ichar ('0') + 32)) call abort + if (f(2:2).ne.char (ichar ('0') + 64)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr4.f90 b/libgomp/testsuite/libgomp.fortran/udr4.f90 new file mode 100644 index 00000000000..89365476af7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr4.f90 @@ -0,0 +1,50 @@ +! { dg-do run } + +!$omp declare reduction (foo : character(kind=1, len=*) & +!$omp & : omp_out = fn (omp_out, omp_in)) initializer (omp_priv = '') +!$omp declare reduction (bar : character(kind=1, len=:) & +!$omp & : omp_out = fn (omp_in, omp_out)) initializer (omp_priv = '') +!$omp declare reduction (baz : character(kind=1, len=1) & +!$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) & +!$omp & - ichar ('0'))) initializer (omp_priv = '0') +!$omp declare reduction (baz : character(kind=1, len=2) & +!$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) & +!$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + & +!$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00') + interface + elemental function fn (x, y) + character (len=64), intent (in) :: x, y + character (len=64) :: fn + end function + end interface + character(kind=1, len=64) :: c(-3:-2,1:1,7:8), d(2:3,-7:-5) + character(kind = 1, len=1) :: e(2:4) + character(kind = 1, len=1+1) :: f(8:10,9:10) + integer :: i, j, k + c = '' + d = '' + e = '0' + f = '00' +!$omp parallel do reduction (foo : c) reduction (bar : d) & +!$omp & reduction (baz : e, f) private (j, k) + do i = 1, 64 + forall (j = -3:-2, k = 7:8) & + c(j,1,k) = trim(c(j,1,k)) // char (ichar ('0') + i) + d = char (ichar ('0') + i) // d + e = char (ichar (e) + mod (i, 3)) + f = char (ichar (f(:,:)(1:1)) + mod (i, 2)) & +& // char (ichar (f(:,:)(2:2)) + mod (i, 3)) + end do + do i = 1, 64 + if (any (index (c, char (ichar ('0') + i)) .eq. 0)) call abort + if (any (index (d, char (ichar ('0') + i)) .eq. 0)) call abort + end do + if (any (e.ne.char (ichar ('0') + 64))) call abort + if (any (f(:,:)(1:1).ne.char (ichar ('0') + 32))) call abort + if (any (f(:,:)(2:2).ne.char (ichar ('0') + 64))) call abort +end +elemental function fn (x, y) + character (len=64), intent (in) :: x, y + character (len=64) :: fn + fn = trim(x) // y +end function diff --git a/libgomp/testsuite/libgomp.fortran/udr5.f90 b/libgomp/testsuite/libgomp.fortran/udr5.f90 new file mode 100644 index 00000000000..6dae9b9b816 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr5.f90 @@ -0,0 +1,57 @@ +! { dg-do run } + +module m + interface operator(.add.) + module procedure do_add + end interface + type dt + real :: r = 0.0 + end type +contains + function do_add(x, y) + type (dt), intent (in) :: x, y + type (dt) :: do_add + do_add%r = x%r + y%r + end function + subroutine dp_add(x, y) + double precision :: x, y + x = x + y + end subroutine + subroutine dp_init(x) + double precision :: x + x = 0.0 + end subroutine +end module + +program udr5 + use m, only : operator(.add.), dt, dp_add, dp_init + type(dt) :: xdt, one + real :: r + integer (kind = 4) :: i4 + integer (kind = 8) :: i8 + real (kind = 4) :: r4 + double precision :: dp +!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in) +!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) & +!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) & +!$omp & initializer (dp_init (omp_priv)) + + one%r = 1.0 + r = 0.0 + i4 = 0 + i8 = 0 + r4 = 0.0 + call dp_init (dp) +!$omp parallel reduction(.add.: xdt) reduction(+: r) & +!$omp & reduction(foo: i4, i8, r4, dp) + xdt = xdt.add.one + r = r + 1.0 + i4 = i4 + 1 + i8 = i8 + 1 + r4 = r4 + 1.0 + call dp_add (dp, 1.0d0) +!$omp end parallel + if (xdt%r .ne. r) call abort + if (i4.ne.r.or.i8.ne.r.or.r4.ne.r.or.dp.ne.r) call abort +end program udr5 diff --git a/libgomp/testsuite/libgomp.fortran/udr6.f90 b/libgomp/testsuite/libgomp.fortran/udr6.f90 new file mode 100644 index 00000000000..20736fb79db --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr6.f90 @@ -0,0 +1,69 @@ +! { dg-do run } + +module m + interface operator(.add.) + module procedure do_add + end interface + type dt + real :: r = 0.0 + end type +contains + elemental function do_add(x, y) + type (dt), intent (in) :: x, y + type (dt) :: do_add + do_add%r = x%r + y%r + end function + elemental subroutine dp_add(x, y) + double precision, intent (inout) :: x + double precision, intent (in) :: y + x = x + y + end subroutine + elemental subroutine dp_init(x) + double precision, intent (out) :: x + x = 0.0 + end subroutine +end module + +program udr6 + use m, only : operator(.add.), dt, dp_add, dp_init + type(dt), allocatable :: xdt(:) + type(dt) :: one + real :: r + integer (kind = 4), allocatable, dimension(:) :: i4 + integer (kind = 8), allocatable, dimension(:,:) :: i8 + integer :: i + real (kind = 4), allocatable :: r4(:,:) + double precision, allocatable :: dp(:) +!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in) +!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) & +!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) & +!$omp & initializer (dp_init (omp_priv)) + + one%r = 1.0 + allocate (xdt(4), i4 (3), i8(-5:-2,2:3), r4(2:5,1:1), dp(7)) + r = 0.0 + i4 = 0 + i8 = 0 + r4 = 0.0 + do i = 1, 7 + call dp_init (dp(i)) + end do +!$omp parallel reduction(.add.: xdt) reduction(+: r) & +!$omp & reduction(foo: i4, i8, r4, dp) private(i) + do i = 1, 4 + xdt(i) = xdt(i).add.one + end do + r = r + 1.0 + i4 = i4 + 1 + i8 = i8 + 1 + r4 = r4 + 1.0 + do i = 1, 7 + call dp_add (dp(i), 1.0d0) + end do +!$omp end parallel + if (any (xdt%r .ne. r)) call abort + if (any (i4.ne.r).or.any(i8.ne.r)) call abort + if (any(r4.ne.r).or.any(dp.ne.r)) call abort + deallocate (xdt, i4, i8, r4, dp) +end program udr6 diff --git a/libgomp/testsuite/libgomp.fortran/udr7.f90 b/libgomp/testsuite/libgomp.fortran/udr7.f90 new file mode 100644 index 00000000000..42be00c3a16 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr7.f90 @@ -0,0 +1,46 @@ +! { dg-do run } + +program udr7 + implicit none + interface + elemental subroutine omp_priv (x, y, z) + real, intent (in) :: x + real, intent (inout) :: y + real, intent (in) :: z + end subroutine omp_priv + elemental real function omp_orig (x) + real, intent (in) :: x + end function omp_orig + end interface +!$omp declare reduction (omp_priv : real : & +!$omp & omp_priv (omp_orig (omp_in), omp_out, 1.0)) & +!$omp & initializer (omp_out (omp_priv, omp_in (omp_orig))) + real :: x (2:4, 1:1, -2:0) + integer :: i + x = 0 +!$omp parallel do reduction (omp_priv : x) + do i = 1, 64 + x = x + i + end do + if (any (x /= 2080.0)) call abort +contains + elemental subroutine omp_out (x, y) + real, intent (out) :: x + real, intent (in) :: y + x = y - 4.0 + end subroutine omp_out + elemental real function omp_in (x) + real, intent (in) :: x + omp_in = x + 4.0 + end function omp_in +end program udr7 +elemental subroutine omp_priv (x, y, z) + real, intent (in) :: x + real, intent (inout) :: y + real, intent (in) :: z + y = y + (x - 4.0) + (z - 1.0) +end subroutine omp_priv +elemental real function omp_orig (x) + real, intent (in) :: x + omp_orig = x + 4.0 +end function omp_orig diff --git a/libgomp/testsuite/libgomp.fortran/udr8.f90 b/libgomp/testsuite/libgomp.fortran/udr8.f90 new file mode 100644 index 00000000000..9ef48a5c787 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr8.f90 @@ -0,0 +1,46 @@ +! { dg-do run } + +module udr8m1 + integer, parameter :: a = 6 + integer :: b +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) +!$omp declare reduction (.add. : integer : & +!$omp & omp_out = omp_out .add. iand (omp_in, -4)) & +!$omp & initializer (omp_priv = 3) + interface operator (.add.) + module procedure f1 + end interface +contains + integer function f1 (x, y) + integer, intent (in) :: x, y + f1 = x + y + end function f1 +end module udr8m1 +module udr8m2 + use udr8m1 + type dt + integer :: x + end type +!$omp declare reduction (+ : dt : omp_out = omp_out + omp_in) & +!$omp & initializer (omp_priv = dt (0)) + interface operator (+) + module procedure f2 + end interface +contains + type(dt) function f2 (x, y) + type(dt), intent (in) :: x, y + f2%x = x%x + y%x + end function f2 +end module udr8m2 + use udr8m2 + integer :: i, j + type(dt) :: d + j = 3 + d%x = 0 +!$omp parallel do reduction (.add.: j) reduction (+ : d) + do i = 1, 100 + j = j.add.iand (i, -4) + d = d + dt(i) + end do + if (d%x /= 5050 .or. j /= 4903) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr9.f90 b/libgomp/testsuite/libgomp.fortran/udr9.f90 new file mode 100644 index 00000000000..a4fec1337c2 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr9.f90 @@ -0,0 +1,65 @@ +! { dg-do run } + +module udr9m1 + integer, parameter :: a = 6 + integer :: b +!$omp declare reduction (foo : integer : combiner1 (omp_out, omp_in)) & +!$omp & initializer (initializer1 (omp_priv, omp_orig)) +!$omp declare reduction (.add. : integer : & +!$omp & combiner1 (omp_out, omp_in)) & +!$omp & initializer (initializer1 (omp_priv, omp_orig)) + interface operator (.add.) + module procedure f1 + end interface +contains + integer function f1 (x, y) + integer, intent (in) :: x, y + f1 = x + y + end function f1 + elemental subroutine combiner1 (x, y) + integer, intent (inout) :: x + integer, intent (in) :: y + x = x + iand (y, -4) + end subroutine + subroutine initializer1 (x, y) + integer :: x, y + if (y .ne. 3) call abort + x = y + end subroutine +end module udr9m1 +module udr9m2 + use udr9m1 + type dt + integer :: x + end type +!$omp declare reduction (+ : dt : combiner2 (omp_in, omp_out)) & +!$omp & initializer (initializer2 (omp_priv)) + interface operator (+) + module procedure f2 + end interface +contains + type(dt) function f2 (x, y) + type(dt), intent (in) :: x, y + f2%x = x%x + y%x + end function f2 + subroutine combiner2 (x, y) + type(dt) :: x, y + y = y + x + end subroutine combiner2 + subroutine initializer2 (x) + type(dt), intent(out) :: x + x%x = 0 + end subroutine initializer2 +end module udr9m2 + use udr9m2 + integer :: i, j + type(dt) :: d + j = 3 + d%x = 0 +!$omp parallel do reduction (.add.: j) reduction (+ : d) + do i = 1, 100 + j = j.add.iand (i, -4) + d = d + dt(i) + end do + if (d%x /= 5050 .or. j /= 4903) call abort +end |