diff options
Diffstat (limited to 'libgomp')
-rw-r--r-- | libgomp/ChangeLog | 14 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 | 328 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 | 367 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 | 372 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocatable10.f90 | 112 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocatable11.f90 | 72 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocatable12.f90 | 74 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocatable9.f90 | 156 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/associate1.f90 | 23 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/associate2.f90 | 46 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/procptr1.f90 | 42 |
11 files changed, 1606 insertions, 0 deletions
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ff389bc..8e6d37a 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,17 @@ +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. 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 0000000..2a2a12e --- /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 0000000..490ed24 --- /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 0000000..20f1314 --- /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 0000000..54eed61 --- /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 0000000..479f604 --- /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 0000000..533ab7c --- /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 0000000..80bf5d3 --- /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 0000000..e409955 --- /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 0000000..dee8496 --- /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/procptr1.f90 b/libgomp/testsuite/libgomp.fortran/procptr1.f90 new file mode 100644 index 0000000..4187739 --- /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 |