summaryrefslogtreecommitdiff
path: root/libgomp/testsuite/libgomp.fortran
diff options
context:
space:
mode:
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable1.f9081
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable2.f9047
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable3.f9021
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable4.f9047
-rw-r--r--libgomp/testsuite/libgomp.fortran/collapse1.f9026
-rw-r--r--libgomp/testsuite/libgomp.fortran/collapse2.f9053
-rw-r--r--libgomp/testsuite/libgomp.fortran/collapse3.f90204
-rw-r--r--libgomp/testsuite/libgomp.fortran/collapse4.f9012
-rw-r--r--libgomp/testsuite/libgomp.fortran/lastprivate1.f90126
-rw-r--r--libgomp/testsuite/libgomp.fortran/lastprivate2.f90141
-rw-r--r--libgomp/testsuite/libgomp.fortran/lib4.f9016
-rw-r--r--libgomp/testsuite/libgomp.fortran/lock-1.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/lock-2.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/nested1.f9087
-rw-r--r--libgomp/testsuite/libgomp.fortran/nestedfn4.f9041
-rw-r--r--libgomp/testsuite/libgomp.fortran/strassen.f9075
-rw-r--r--libgomp/testsuite/libgomp.fortran/tabs1.f9012
-rw-r--r--libgomp/testsuite/libgomp.fortran/tabs2.f13
-rw-r--r--libgomp/testsuite/libgomp.fortran/task1.f9027
-rw-r--r--libgomp/testsuite/libgomp.fortran/task2.f90142
-rw-r--r--libgomp/testsuite/libgomp.fortran/vla4.f902
-rw-r--r--libgomp/testsuite/libgomp.fortran/vla5.f902
22 files changed, 1221 insertions, 2 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable1.f90 b/libgomp/testsuite/libgomp.fortran/allocatable1.f90
new file mode 100644
index 00000000000..1efe2abe959
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable1.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+!$ use omp_lib
+
+ integer, allocatable :: a(:, :)
+ integer :: b(6, 3)
+ integer :: i, j
+ logical :: k, l
+ b(:, :) = 16
+ l = .false.
+ if (allocated (a)) call abort
+!$omp parallel private (a, b) reduction (.or.:l)
+ l = l.or.allocated (a)
+ allocate (a(3, 6))
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.18.or.size(a,1).ne.3.or.size(a,2).ne.6
+ a(3, 2) = 1
+ b(3, 2) = 1
+ deallocate (a)
+ l = l.or.allocated (a)
+!$omp end parallel
+ if (allocated (a).or.l) call abort
+ allocate (a(6, 3))
+ a(:, :) = 3
+ if (.not.allocated (a)) call abort
+ l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3
+ if (l) call abort
+!$omp parallel private (a, b) reduction (.or.:l)
+ l = l.or..not.allocated (a)
+ a(3, 2) = 1
+ b(3, 2) = 1
+!$omp end parallel
+ if (l.or..not.allocated (a)) call abort
+!$omp parallel firstprivate (a, b) reduction (.or.:l)
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3
+ do i = 1, 6
+ l = l.or.(a(i, 1).ne.3).or.(a(i, 2).ne.3)
+ l = l.or.(a(i, 3).ne.3).or.(b(i, 1).ne.16)
+ l = l.or.(b(i, 2).ne.16).or.(b(i, 3).ne.16)
+ end do
+ a(:, :) = omp_get_thread_num ()
+ b(:, :) = omp_get_thread_num ()
+!$omp end parallel
+ if (any (a.ne.3).or.any (b.ne.16).or.l) call abort
+ k = .true.
+!$omp parallel do firstprivate (a, b, k) lastprivate (a, b) &
+!$omp & reduction (.or.:l)
+ do i = 1, 36
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3
+ if (k) then
+ do j = 1, 6
+ l = l.or.(a(j, 1).ne.3).or.(a(j, 2).ne.3)
+ l = l.or.(a(j, 3).ne.3).or.(b(j, 1).ne.16)
+ l = l.or.(b(j, 2).ne.16).or.(b(j, 3).ne.16)
+ end do
+ k = .false.
+ end if
+ a(:, :) = i + 2
+ b(:, :) = i
+ end do
+ if (any (a.ne.38).or.any (b.ne.36).or.l) call abort
+ deallocate (a)
+ if (allocated (a)) call abort
+ allocate (a (0:1, 0:3))
+ a(:, :) = 0
+!$omp parallel do reduction (+:a) reduction (.or.:l) &
+!$omp & num_threads(3) schedule(static)
+ do i = 0, 7
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.8.or.size(a,1).ne.2.or.size(a,2).ne.4
+ a(modulo (i, 2), i / 2) = a(modulo (i, 2), i / 2) + i
+ a(i / 4, modulo (i, 4)) = a(i / 4, modulo (i, 4)) + i
+ end do
+ if (l) call abort
+ do i = 0, 1
+ do j = 0, 3
+ if (a(i, j) .ne. (5*i + 3*j)) call abort
+ end do
+ end do
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable2.f90 b/libgomp/testsuite/libgomp.fortran/allocatable2.f90
new file mode 100644
index 00000000000..a37616b04b1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable2.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+!$ use omp_lib
+
+ integer, save, allocatable :: a(:, :)
+ integer, allocatable :: b(:, :)
+ integer :: n
+ logical :: l
+!$omp threadprivate (a)
+ if (allocated (a)) call abort
+ call omp_set_dynamic (.false.)
+ l = .false.
+!$omp parallel num_threads (4) reduction(.or.:l)
+ allocate (a(-1:1, 7:10))
+ a(:, :) = omp_get_thread_num () + 6
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4
+!$omp end parallel
+ if (l.or.any(a.ne.6)) call abort ()
+!$omp parallel num_threads (4) copyin (a) reduction(.or.:l) private (b)
+ l = l.or.allocated (b)
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4
+ l = l.or.any(a.ne.6)
+ allocate (b(1, 3))
+ a(:, :) = omp_get_thread_num () + 36
+ b(:, :) = omp_get_thread_num () + 66
+ !$omp single
+ n = omp_get_thread_num ()
+ !$omp end single copyprivate (a, b)
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4
+ l = l.or.any(a.ne.(n + 36))
+ l = l.or..not.allocated (b)
+ l = l.or.size(b).ne.3.or.size(b,1).ne.1.or.size(b,2).ne.3
+ l = l.or.any(b.ne.(n + 66))
+ deallocate (b)
+ l = l.or.allocated (b)
+!$omp end parallel
+ if (n.lt.0 .or. n.ge.4) call abort
+ if (l.or.any(a.ne.(n + 36))) call abort
+!$omp parallel num_threads (4) reduction(.or.:l)
+ deallocate (a)
+ l = l.or.allocated (a)
+!$omp end parallel
+ if (l.or.allocated (a)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable3.f90 b/libgomp/testsuite/libgomp.fortran/allocatable3.f90
new file mode 100644
index 00000000000..fe3714a2b1f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable3.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+
+ integer, allocatable :: a(:)
+ integer :: i
+ logical :: l
+ l = .false.
+ if (allocated (a)) call abort
+!$omp parallel private (a) reduction (.or.:l)
+ allocate (a (-7:-5))
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.3.or.size(a,1).ne.3
+ a(:) = 0
+ !$omp do private (a)
+ do i = 1, 7
+ a(:) = i
+ l = l.or.any (a.ne.i)
+ end do
+ l = l.or.any (a.ne.0)
+ deallocate (a)
+!$omp end parallel
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable4.f90 b/libgomp/testsuite/libgomp.fortran/allocatable4.f90
new file mode 100644
index 00000000000..996578c94fa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable4.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+
+ integer, allocatable :: a(:, :)
+ integer :: b(6, 3)
+ integer :: i, j
+ logical :: k, l
+ b(:, :) = 16
+ l = .false.
+ if (allocated (a)) call abort
+!$omp task private (a, b) shared (l)
+ l = l.or.allocated (a)
+ allocate (a(3, 6))
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.18.or.size(a,1).ne.3.or.size(a,2).ne.6
+ a(3, 2) = 1
+ b(3, 2) = 1
+ deallocate (a)
+ l = l.or.allocated (a)
+!$omp end task
+!$omp taskwait
+ if (allocated (a).or.l) call abort
+ allocate (a(6, 3))
+ a(:, :) = 3
+ if (.not.allocated (a)) call abort
+ l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3
+ if (l) call abort
+!$omp task private (a, b) shared (l)
+ l = l.or..not.allocated (a)
+ a(3, 2) = 1
+ b(3, 2) = 1
+!$omp end task
+!$omp taskwait
+ if (l.or..not.allocated (a)) call abort
+!$omp task firstprivate (a, b) shared (l)
+ l = l.or..not.allocated (a)
+ l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3
+ do i = 1, 6
+ l = l.or.(a(i, 1).ne.3).or.(a(i, 2).ne.3)
+ l = l.or.(a(i, 3).ne.3).or.(b(i, 1).ne.16)
+ l = l.or.(b(i, 2).ne.16).or.(b(i, 3).ne.16)
+ end do
+ a(:, :) = 7
+ b(:, :) = 8
+!$omp end task
+!$omp taskwait
+ if (any (a.ne.3).or.any (b.ne.16).or.l) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/collapse1.f90 b/libgomp/testsuite/libgomp.fortran/collapse1.f90
new file mode 100644
index 00000000000..1ecfa0c9365
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/collapse1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+program collapse1
+ integer :: i, j, k, a(1:3, 4:6, 5:7)
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse(4 - 1) schedule(static, 4)
+ do i = 1, 3
+ do j = 4, 6
+ do k = 5, 7
+ a(i, j, k) = i + j + k
+ end do
+ end do
+ end do
+ !$omp parallel do collapse(2) reduction(.or.:l)
+ do i = 1, 3
+ do j = 4, 6
+ do k = 5, 7
+ if (a(i, j, k) .ne. (i + j + k)) l = .true.
+ end do
+ end do
+ end do
+ !$omp end parallel do
+ if (l) call abort
+end program collapse1
diff --git a/libgomp/testsuite/libgomp.fortran/collapse2.f90 b/libgomp/testsuite/libgomp.fortran/collapse2.f90
new file mode 100644
index 00000000000..77e0dee8260
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/collapse2.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+
+program collapse2
+ call test1
+ call test2
+contains
+ subroutine test1
+ integer :: i, j, k, a(1:3, 4:6, 5:7)
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse(4 - 1) schedule(static, 4)
+ do 164 i = 1, 3
+ do 164 j = 4, 6
+ do 164 k = 5, 7
+ a(i, j, k) = i + j + k
+164 end do
+ !$omp parallel do collapse(2) reduction(.or.:l)
+firstdo: do i = 1, 3
+ do j = 4, 6
+ do k = 5, 7
+ if (a(i, j, k) .ne. (i + j + k)) l = .true.
+ end do
+ end do
+ end do firstdo
+ !$omp end parallel do
+ if (l) call abort
+ end subroutine test1
+
+ subroutine test2
+ integer :: a(3,3,3), k, kk, kkk, l, ll, lll
+ !$omp do collapse(3)
+ do 115 k=1,3
+ dokk: do kk=1,3
+ do kkk=1,3
+ a(k,kk,kkk) = 1
+ enddo
+ enddo dokk
+115 continue
+ if (any(a(1:3,1:3,1:3).ne.1)) call abort
+
+ !$omp do collapse(3)
+ dol: do 120 l=1,3
+ doll: do ll=1,3
+ do lll=1,3
+ a(l,ll,lll) = 2
+ enddo
+ enddo doll
+120 end do dol
+ if (any(a(1:3,1:3,1:3).ne.2)) call abort
+ end subroutine test2
+
+end program collapse2
diff --git a/libgomp/testsuite/libgomp.fortran/collapse3.f90 b/libgomp/testsuite/libgomp.fortran/collapse3.f90
new file mode 100644
index 00000000000..eac9eac651b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/collapse3.f90
@@ -0,0 +1,204 @@
+! { dg-do run }
+
+program collapse3
+ call test1
+ call test2 (2, 6, -2, 4, 13, 18)
+ call test3 (2, 6, -2, 4, 13, 18, 1, 1, 1)
+ call test4
+ call test5 (2, 6, -2, 4, 13, 18)
+ call test6 (2, 6, -2, 4, 13, 18, 1, 1, 1)
+contains
+ subroutine test1
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l)
+ do i = 2, 6
+ do j = -2, 4
+ do k = 13, 18
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test1
+
+ subroutine test2(v1, v2, v3, v4, v5, v6)
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ integer :: v1, v2, v3, v4, v5, v6
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l)
+ do i = v1, v2
+ do j = v3, v4
+ do k = v5, v6
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test2
+
+ subroutine test3(v1, v2, v3, v4, v5, v6, v7, v8, v9)
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ integer :: v1, v2, v3, v4, v5, v6, v7, v8, v9
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l)
+ do i = v1, v2, v7
+ do j = v3, v4, v8
+ do k = v5, v6, v9
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test3
+
+ subroutine test4
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) &
+ !$omp& schedule (dynamic, 5)
+ do i = 2, 6
+ do j = -2, 4
+ do k = 13, 18
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test4
+
+ subroutine test5(v1, v2, v3, v4, v5, v6)
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ integer :: v1, v2, v3, v4, v5, v6
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) &
+ !$omp & schedule (guided)
+ do i = v1, v2
+ do j = v3, v4
+ do k = v5, v6
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test5
+
+ subroutine test6(v1, v2, v3, v4, v5, v6, v7, v8, v9)
+ integer :: i, j, k, a(1:7, -3:5, 12:19), m
+ integer :: v1, v2, v3, v4, v5, v6, v7, v8, v9
+ logical :: l
+ l = .false.
+ a(:, :, :) = 0
+ !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) &
+ !$omp & schedule (dynamic)
+ do i = v1, v2, v7
+ do j = v3, v4, v8
+ do k = v5, v6, v9
+ l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4
+ l = l.or.k.lt.13.or.k.gt.18
+ if (.not.l) a(i, j, k) = a(i, j, k) + 1
+ m = i * 100 + j * 10 + k
+ end do
+ end do
+ end do
+ if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort
+ if (m.ne.(600+40+18)) call abort
+ do i = 1, 7
+ do j = -3, 5
+ do k = 12, 19
+ if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then
+ if (a(i, j, k).ne.0) print *, i, j, k
+ else
+ if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k)
+ end if
+ end do
+ end do
+ end do
+ end subroutine test6
+
+end program collapse3
diff --git a/libgomp/testsuite/libgomp.fortran/collapse4.f90 b/libgomp/testsuite/libgomp.fortran/collapse4.f90
new file mode 100644
index 00000000000..f19b0f6c695
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/collapse4.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+
+ integer :: i, j, k
+ !$omp parallel do lastprivate (i, j, k) collapse (3)
+ do i = 0, 17
+ do j = 0, 6
+ do k = 0, 5
+ end do
+ end do
+ end do
+ if (i .ne. 18 .or. j .ne. 7 .or. k .ne. 6) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/lastprivate1.f90 b/libgomp/testsuite/libgomp.fortran/lastprivate1.f90
new file mode 100644
index 00000000000..91bb96ca75a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lastprivate1.f90
@@ -0,0 +1,126 @@
+program lastprivate
+ integer :: i
+ common /c/ i
+ !$omp parallel num_threads (4)
+ call test1
+ !$omp end parallel
+ if (i .ne. 21) call abort
+ !$omp parallel num_threads (4)
+ call test2
+ !$omp end parallel
+ if (i .ne. 64) call abort
+ !$omp parallel num_threads (4)
+ call test3
+ !$omp end parallel
+ if (i .ne. 14) call abort
+ call test4
+ call test5
+ call test6
+ call test7
+ call test8
+ call test9
+ call test10
+ call test11
+ call test12
+contains
+ subroutine test1
+ integer :: i
+ common /c/ i
+ !$omp do lastprivate (i)
+ do i = 1, 20
+ end do
+ end subroutine test1
+ subroutine test2
+ integer :: i
+ common /c/ i
+ !$omp do lastprivate (i)
+ do i = 7, 61, 3
+ end do
+ end subroutine test2
+ function ret3 ()
+ integer :: ret3
+ ret3 = 3
+ end function ret3
+ subroutine test3
+ integer :: i
+ common /c/ i
+ !$omp do lastprivate (i)
+ do i = -10, 11, ret3 ()
+ end do
+ end subroutine test3
+ subroutine test4
+ integer :: j
+ !$omp parallel do lastprivate (j) num_threads (4) default (none)
+ do j = 1, 20
+ end do
+ if (j .ne. 21) call abort
+ end subroutine test4
+ subroutine test5
+ integer :: j
+ !$omp parallel do lastprivate (j) num_threads (4) default (none)
+ do j = 7, 61, 3
+ end do
+ if (j .ne. 64) call abort
+ end subroutine test5
+ subroutine test6
+ integer :: j
+ !$omp parallel do lastprivate (j) num_threads (4) default (none)
+ do j = -10, 11, ret3 ()
+ end do
+ if (j .ne. 14) call abort
+ end subroutine test6
+ subroutine test7
+ integer :: i
+ common /c/ i
+ !$omp parallel do lastprivate (i) num_threads (4) default (none)
+ do i = 1, 20
+ end do
+ if (i .ne. 21) call abort
+ end subroutine test7
+ subroutine test8
+ integer :: i
+ common /c/ i
+ !$omp parallel do lastprivate (i) num_threads (4) default (none)
+ do i = 7, 61, 3
+ end do
+ if (i .ne. 64) call abort
+ end subroutine test8
+ subroutine test9
+ integer :: i
+ common /c/ i
+ !$omp parallel do lastprivate (i) num_threads (4) default (none)
+ do i = -10, 11, ret3 ()
+ end do
+ if (i .ne. 14) call abort
+ end subroutine test9
+ subroutine test10
+ integer :: i
+ common /c/ i
+ !$omp parallel num_threads (4) default (none) shared (i)
+ !$omp do lastprivate (i)
+ do i = 1, 20
+ end do
+ !$omp end parallel
+ if (i .ne. 21) call abort
+ end subroutine test10
+ subroutine test11
+ integer :: i
+ common /c/ i
+ !$omp parallel num_threads (4) default (none) shared (i)
+ !$omp do lastprivate (i)
+ do i = 7, 61, 3
+ end do
+ !$omp end parallel
+ if (i .ne. 64) call abort
+ end subroutine test11
+ subroutine test12
+ integer :: i
+ common /c/ i
+ !$omp parallel num_threads (4) default (none) shared (i)
+ !$omp do lastprivate (i)
+ do i = -10, 11, ret3 ()
+ end do
+ !$omp end parallel
+ if (i .ne. 14) call abort
+ end subroutine test12
+end program lastprivate
diff --git a/libgomp/testsuite/libgomp.fortran/lastprivate2.f90 b/libgomp/testsuite/libgomp.fortran/lastprivate2.f90
new file mode 100644
index 00000000000..6d7e11eab00
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lastprivate2.f90
@@ -0,0 +1,141 @@
+program lastprivate
+ integer :: i, k
+ common /c/ i, k
+ !$omp parallel num_threads (4)
+ call test1
+ !$omp end parallel
+ if (i .ne. 21 .or. k .ne. 20) call abort
+ !$omp parallel num_threads (4)
+ call test2
+ !$omp end parallel
+ if (i .ne. 64 .or. k .ne. 61) call abort
+ !$omp parallel num_threads (4)
+ call test3
+ !$omp end parallel
+ if (i .ne. 14 .or. k .ne. 11) call abort
+ call test4
+ call test5
+ call test6
+ call test7
+ call test8
+ call test9
+ call test10
+ call test11
+ call test12
+contains
+ subroutine test1
+ integer :: i, k
+ common /c/ i, k
+ !$omp do lastprivate (i, k)
+ do i = 1, 20
+ k = i
+ end do
+ end subroutine test1
+ subroutine test2
+ integer :: i, k
+ common /c/ i, k
+ !$omp do lastprivate (i, k)
+ do i = 7, 61, 3
+ k = i
+ end do
+ end subroutine test2
+ function ret3 ()
+ integer :: ret3
+ ret3 = 3
+ end function ret3
+ subroutine test3
+ integer :: i, k
+ common /c/ i, k
+ !$omp do lastprivate (i, k)
+ do i = -10, 11, ret3 ()
+ k = i
+ end do
+ end subroutine test3
+ subroutine test4
+ integer :: j, l
+ !$omp parallel do lastprivate (j, l) num_threads (4)
+ do j = 1, 20
+ l = j
+ end do
+ if (j .ne. 21 .or. l .ne. 20) call abort
+ end subroutine test4
+ subroutine test5
+ integer :: j, l
+ l = 77
+ !$omp parallel do lastprivate (j, l) num_threads (4) firstprivate (l)
+ do j = 7, 61, 3
+ l = j
+ end do
+ if (j .ne. 64 .or. l .ne. 61) call abort
+ end subroutine test5
+ subroutine test6
+ integer :: j, l
+ !$omp parallel do lastprivate (j, l) num_threads (4)
+ do j = -10, 11, ret3 ()
+ l = j
+ end do
+ if (j .ne. 14 .or. l .ne. 11) call abort
+ end subroutine test6
+ subroutine test7
+ integer :: i, k
+ common /c/ i, k
+ !$omp parallel do lastprivate (i, k) num_threads (4)
+ do i = 1, 20
+ k = i
+ end do
+ if (i .ne. 21 .or. k .ne. 20) call abort
+ end subroutine test7
+ subroutine test8
+ integer :: i, k
+ common /c/ i, k
+ !$omp parallel do lastprivate (i, k) num_threads (4)
+ do i = 7, 61, 3
+ k = i
+ end do
+ if (i .ne. 64 .or. k .ne. 61) call abort
+ end subroutine test8
+ subroutine test9
+ integer :: i, k
+ common /c/ i, k
+ k = 77
+ !$omp parallel do lastprivate (i, k) num_threads (4) firstprivate (k)
+ do i = -10, 11, ret3 ()
+ k = i
+ end do
+ if (i .ne. 14 .or. k .ne. 11) call abort
+ end subroutine test9
+ subroutine test10
+ integer :: i, k
+ common /c/ i, k
+ !$omp parallel num_threads (4)
+ !$omp do lastprivate (i, k)
+ do i = 1, 20
+ k = i
+ end do
+ !$omp end parallel
+ if (i .ne. 21 .or. k .ne. 20) call abort
+ end subroutine test10
+ subroutine test11
+ integer :: i, k
+ common /c/ i, k
+ !$omp parallel num_threads (4)
+ !$omp do lastprivate (i, k)
+ do i = 7, 61, 3
+ k = i
+ end do
+ !$omp end parallel
+ if (i .ne. 64 .or. k .ne. 61) call abort
+ end subroutine test11
+ subroutine test12
+ integer :: i, k
+ common /c/ i, k
+ k = 77
+ !$omp parallel num_threads (4)
+ !$omp do lastprivate (i, k) firstprivate (k)
+ do i = -10, 11, ret3 ()
+ k = i
+ end do
+ !$omp end parallel
+ if (i .ne. 14 .or. k .ne. 11) call abort
+ end subroutine test12
+end program lastprivate
diff --git a/libgomp/testsuite/libgomp.fortran/lib4.f90 b/libgomp/testsuite/libgomp.fortran/lib4.f90
new file mode 100644
index 00000000000..cbb984574ff
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+
+program lib4
+ use omp_lib
+ integer (omp_sched_kind) :: kind
+ integer :: modifier
+ call omp_set_schedule (omp_sched_static, 32)
+ call omp_get_schedule (kind, modifier)
+ if (kind.ne.omp_sched_static.or.modifier.ne.32) call abort
+ call omp_set_schedule (omp_sched_dynamic, 4)
+ call omp_get_schedule (kind, modifier)
+ if (kind.ne.omp_sched_dynamic.or.modifier.ne.4) call abort
+ if (omp_get_thread_limit ().lt.0) call abort
+ call omp_set_max_active_levels (6)
+ if (omp_get_max_active_levels ().ne.6) call abort
+end program lib4
diff --git a/libgomp/testsuite/libgomp.fortran/lock-1.f90 b/libgomp/testsuite/libgomp.fortran/lock-1.f90
new file mode 100644
index 00000000000..d7d3e3fd6cc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lock-1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+ use omp_lib
+
+ integer (kind = omp_nest_lock_kind) :: lock
+ logical :: l
+
+ l = .false.
+ call omp_init_nest_lock (lock)
+ if (omp_test_nest_lock (lock) .ne. 1) call abort
+ if (omp_test_nest_lock (lock) .ne. 2) call abort
+!$omp parallel if (.false.) reduction (.or.:l)
+ ! In OpenMP 2.5 this was supposed to return 3,
+ ! but in OpenMP 3.0 the parallel region has a different
+ ! task and omp_*_lock_t are owned by tasks, not by threads.
+ if (omp_test_nest_lock (lock) .ne. 0) l = .true.
+!$omp end parallel
+ if (l) call abort
+ if (omp_test_nest_lock (lock) .ne. 3) call abort
+ call omp_unset_nest_lock (lock)
+ call omp_unset_nest_lock (lock)
+ call omp_unset_nest_lock (lock)
+ call omp_destroy_nest_lock (lock)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/lock-2.f90 b/libgomp/testsuite/libgomp.fortran/lock-2.f90
new file mode 100644
index 00000000000..9965139b9ba
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lock-2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+ use omp_lib
+
+ integer (kind = omp_nest_lock_kind) :: lock
+ logical :: l
+
+ l = .false.
+ call omp_init_nest_lock (lock)
+!$omp parallel num_threads (1) reduction (.or.:l)
+ if (omp_test_nest_lock (lock) .ne. 1) call abort
+ if (omp_test_nest_lock (lock) .ne. 2) call abort
+!$omp task if (.false.) shared (lock, l)
+ if (omp_test_nest_lock (lock) .ne. 0) l = .true.
+!$omp end task
+!$omp taskwait
+ if (omp_test_nest_lock (lock) .ne. 3) l = .true.
+ call omp_unset_nest_lock (lock)
+ call omp_unset_nest_lock (lock)
+ call omp_unset_nest_lock (lock)
+!$omp end parallel
+ if (l) call abort
+ call omp_destroy_nest_lock (lock)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/nested1.f90 b/libgomp/testsuite/libgomp.fortran/nested1.f90
new file mode 100644
index 00000000000..98c4322d0bf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nested1.f90
@@ -0,0 +1,87 @@
+! { dg-do run }
+program nested1
+ use omp_lib
+ integer :: e1, e2, e3, e
+ integer :: tn1, tn2, tn3
+ e1 = 0
+ e2 = 0
+ e3 = 0
+ call omp_set_nested (.true.)
+ call omp_set_dynamic (.false.)
+ if (omp_in_parallel ()) call abort
+ if (omp_get_num_threads ().ne.1) call abort
+ if (omp_get_level ().ne.0) call abort
+ if (omp_get_ancestor_thread_num (0).ne.0) call abort
+ if (omp_get_ancestor_thread_num (-1).ne.-1) call abort
+ if (omp_get_ancestor_thread_num (1).ne.-1) call abort
+ if (omp_get_team_size (0).ne.1) call abort
+ if (omp_get_team_size (-1).ne.-1) call abort
+ if (omp_get_team_size (1).ne.-1) call abort
+ if (omp_get_active_level ().ne.0) call abort
+!$omp parallel num_threads (4) private (e, tn1)
+ e = 0
+ tn1 = omp_get_thread_num ()
+ if (.not.omp_in_parallel ()) e = e + 1
+ if (omp_get_num_threads ().ne.4) e = e + 1
+ if (tn1.lt.0.or.tn1.ge.4) e = e + 1
+ if (omp_get_level ().ne.1) e = e + 1
+ if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1
+ if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1
+ if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1
+ if (omp_get_ancestor_thread_num (2).ne.-1) e = e + 1
+ if (omp_get_team_size (0).ne.1) e = e + 1
+ if (omp_get_team_size (1).ne.4) e = e + 1
+ if (omp_get_team_size (-1).ne.-1) e = e + 1
+ if (omp_get_team_size (2).ne.-1) e = e + 1
+ if (omp_get_active_level ().ne.1) e = e + 1
+ !$omp atomic
+ e1 = e1 + e
+!$omp parallel num_threads (5) if (.false.) firstprivate (tn1) &
+!$omp& private (e, tn2)
+ e = 0
+ tn2 = omp_get_thread_num ()
+ if (.not.omp_in_parallel ()) e = e + 1
+ if (omp_get_num_threads ().ne.1) e = e + 1
+ if (tn2.ne.0) e = e + 1
+ if (omp_get_level ().ne.2) e = e + 1
+ if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1
+ if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1
+ if (omp_get_ancestor_thread_num (2).ne.tn2) e = e + 1
+ if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1
+ if (omp_get_ancestor_thread_num (3).ne.-1) e = e + 1
+ if (omp_get_team_size (0).ne.1) e = e + 1
+ if (omp_get_team_size (1).ne.4) e = e + 1
+ if (omp_get_team_size (2).ne.1) e = e + 1
+ if (omp_get_team_size (-1).ne.-1) e = e + 1
+ if (omp_get_team_size (3).ne.-1) e = e + 1
+ if (omp_get_active_level ().ne.1) e = e + 1
+ !$omp atomic
+ e2 = e2 + e
+!$omp parallel num_threads (2) firstprivate (tn1, tn2) &
+!$omp& private (e, tn3)
+ e = 0
+ tn3 = omp_get_thread_num ()
+ if (.not.omp_in_parallel ()) e = e + 1
+ if (omp_get_num_threads ().ne.2) e = e + 1
+ if (tn3.lt.0.or.tn3.ge.2) e = e + 1
+ if (omp_get_level ().ne.3) e = e + 1
+ if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1
+ if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1
+ if (omp_get_ancestor_thread_num (2).ne.tn2) e = e + 1
+ if (omp_get_ancestor_thread_num (3).ne.tn3) e = e + 1
+ if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1
+ if (omp_get_ancestor_thread_num (4).ne.-1) e = e + 1
+ if (omp_get_team_size (0).ne.1) e = e + 1
+ if (omp_get_team_size (1).ne.4) e = e + 1
+ if (omp_get_team_size (2).ne.1) e = e + 1
+ if (omp_get_team_size (3).ne.2) e = e + 1
+ if (omp_get_team_size (-1).ne.-1) e = e + 1
+ if (omp_get_team_size (4).ne.-1) e = e + 1
+ if (omp_get_active_level ().ne.2) e = e + 1
+ !$omp atomic
+ e3 = e3 + e
+!$omp end parallel
+!$omp end parallel
+!$omp end parallel
+ if (e1.ne.0.or.e2.ne.0.or.e3.ne.0) call abort
+end program nested1
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn4.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn4.f90
new file mode 100644
index 00000000000..c987bf440b0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn4.f90
@@ -0,0 +1,41 @@
+program foo
+ integer :: i, j, k
+ integer :: a(10), c(10)
+ k = 2
+ a(:) = 0
+ call test1
+ call test2
+ do i = 1, 10
+ if (a(i) .ne. 10 * i) call abort
+ end do
+ !$omp parallel do reduction (+:c)
+ do i = 1, 10
+ c = c + a
+ end do
+ do i = 1, 10
+ if (c(i) .ne. 10 * a(i)) call abort
+ end do
+ !$omp parallel do lastprivate (j)
+ do j = 1, 10, k
+ end do
+ if (j .ne. 11) call abort
+contains
+ subroutine test1
+ integer :: i
+ integer :: b(10)
+ do i = 1, 10
+ b(i) = i
+ end do
+ c(:) = 0
+ !$omp parallel do reduction (+:a)
+ do i = 1, 10
+ a = a + b
+ end do
+ end subroutine test1
+ subroutine test2
+ !$omp parallel do lastprivate (j)
+ do j = 1, 10, k
+ end do
+ if (j .ne. 11) call abort
+ end subroutine test2
+end program foo
diff --git a/libgomp/testsuite/libgomp.fortran/strassen.f90 b/libgomp/testsuite/libgomp.fortran/strassen.f90
new file mode 100644
index 00000000000..b44982665a6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/strassen.f90
@@ -0,0 +1,75 @@
+! { dg-options "-O2" }
+
+program strassen_matmul
+ use omp_lib
+ integer, parameter :: N = 1024
+ double precision, save :: A(N,N), B(N,N), C(N,N), D(N,N)
+ double precision :: start, end
+
+ call random_seed
+ call random_number (A)
+ call random_number (B)
+ start = omp_get_wtime ()
+ C = matmul (A, B)
+ end = omp_get_wtime ()
+ write(*,'(a, f10.6)') ' Time for matmul = ', end - start
+ D = 0
+ start = omp_get_wtime ()
+ call strassen (A, B, D, N)
+ end = omp_get_wtime ()
+ write(*,'(a, f10.6)') ' Time for Strassen = ', end - start
+ if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort
+ D = 0
+ start = omp_get_wtime ()
+!$omp parallel
+!$omp single
+ call strassen (A, B, D, N)
+!$omp end single nowait
+!$omp end parallel
+ end = omp_get_wtime ()
+ write(*,'(a, f10.6)') ' Time for Strassen MP = ', end - start
+ if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort
+
+contains
+
+ recursive subroutine strassen (A, B, C, N)
+ integer, intent(in) :: N
+ double precision, intent(in) :: A(N,N), B(N,N)
+ double precision, intent(out) :: C(N,N)
+ double precision :: T(N/2,N/2,7)
+ integer :: K, L
+
+ if (iand (N,1) .ne. 0 .or. N < 64) then
+ C = matmul (A, B)
+ return
+ end if
+ K = N / 2
+ L = N / 2 + 1
+!$omp task shared (A, B, T)
+ call strassen (A(:K,:K) + A(L:,L:), B(:K,:K) + B(L:,L:), T(:,:,1), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(L:,:K) + A(L:,L:), B(:K,:K), T(:,:,2), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(:K,:K), B(:K,L:) - B(L:,L:), T(:,:,3), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(L:,L:), B(L:,:K) - B(:K,:K), T(:,:,4), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(:K,:K) + A(:K,L:), B(L:,L:), T(:,:,5), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(L:,:K) - A(:K,:K), B(:K,:K) + B(:K,L:), T(:,:,6), K)
+!$omp end task
+!$omp task shared (A, B, T)
+ call strassen (A(:K,L:) - A(L:,L:), B(L:,:K) + B(L:,L:), T(:,:,7), K)
+!$omp end task
+!$omp taskwait
+ C(:K,:K) = T(:,:,1) + T(:,:,4) - T(:,:,5) + T(:,:,7)
+ C(L:,:K) = T(:,:,2) + T(:,:,4)
+ C(:K,L:) = T(:,:,3) + T(:,:,5)
+ C(L:,L:) = T(:,:,1) - T(:,:,2) + T(:,:,3) + T(:,:,6)
+ end subroutine strassen
+end
diff --git a/libgomp/testsuite/libgomp.fortran/tabs1.f90 b/libgomp/testsuite/libgomp.fortran/tabs1.f90
new file mode 100644
index 00000000000..4f3d4f5b435
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/tabs1.f90
@@ -0,0 +1,12 @@
+ if (b().ne.2) call abort
+contains
+subroutine a
+!$omp parallel
+ !$omp end parallel
+ end subroutine a
+function b()
+ integer :: b
+ b = 1
+ !$ b = 2
+end function b
+ end
diff --git a/libgomp/testsuite/libgomp.fortran/tabs2.f b/libgomp/testsuite/libgomp.fortran/tabs2.f
new file mode 100644
index 00000000000..7aed5498d34
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/tabs2.f
@@ -0,0 +1,13 @@
+! { dg-options "-ffixed-form" }
+ if (b().ne.2) call abort
+ contains
+ subroutine a
+!$omp parallel
+!$omp end parallel
+ end subroutine a
+ function b()
+ integer :: b
+ b = 1
+!$ b = 2
+ end function b
+ end
diff --git a/libgomp/testsuite/libgomp.fortran/task1.f90 b/libgomp/testsuite/libgomp.fortran/task1.f90
new file mode 100644
index 00000000000..df57cb83168
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/task1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+
+program tasktest
+ use omp_lib
+ integer :: i, j
+ common /tasktest_j/ j
+ j = 0
+ !$omp parallel private (i)
+ i = omp_get_thread_num ()
+ if (i.lt.2) then
+ !$omp task if (.false.) default(firstprivate)
+ call subr (i + 1)
+ !$omp end task
+ end if
+ !$omp end parallel
+ if (j.gt.0) call abort
+contains
+ subroutine subr (i)
+ use omp_lib
+ integer :: i, j
+ common /tasktest_j/ j
+ if (omp_get_thread_num ().ne.(i - 1)) then
+ !$omp atomic
+ j = j + 1
+ end if
+ end subroutine subr
+end program tasktest
diff --git a/libgomp/testsuite/libgomp.fortran/task2.f90 b/libgomp/testsuite/libgomp.fortran/task2.f90
new file mode 100644
index 00000000000..24ffee53ac8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/task2.f90
@@ -0,0 +1,142 @@
+ integer :: err
+ err = 0
+!$omp parallel num_threads (4) default (none) shared (err)
+!$omp single
+ call test
+!$omp end single
+!$omp end parallel
+ if (err.ne.0) call abort
+contains
+ subroutine check (x, y, l)
+ integer :: x, y
+ logical :: l
+ l = l .or. x .ne. y
+ end subroutine check
+
+ subroutine foo (c, d, e, f, g, h, i, j, k, n)
+ use omp_lib
+ integer :: n
+ character (len = *) :: c
+ character (len = n) :: d
+ integer, dimension (2, 3:5, n) :: e
+ integer, dimension (2, 3:n, n) :: f
+ character (len = *), dimension (5, 3:n) :: g
+ character (len = n), dimension (5, 3:n) :: h
+ real, dimension (:, :, :) :: i
+ double precision, dimension (3:, 5:, 7:) :: j
+ integer, dimension (:, :, :) :: k
+ logical :: l
+ integer :: p, q, r
+ character (len = n) :: s
+ integer, dimension (2, 3:5, n) :: t
+ integer, dimension (2, 3:n, n) :: u
+ character (len = n), dimension (5, 3:n) :: v
+ character (len = 2 * n + 24) :: w
+ integer :: x, z
+ character (len = 1) :: y
+ s = 'PQRSTUV'
+ forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+ forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+ forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+ forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+!$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err)
+ l = .false.
+ l = l .or. c .ne. 'abcdefghijkl'
+ l = l .or. d .ne. 'ABCDEFG'
+ l = l .or. s .ne. 'PQRSTUV'
+ do 100, p = 1, 2
+ do 100, q = 3, 7
+ do 100, r = 1, 7
+ if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+ l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+ if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+ if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+ if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+ if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+ if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+ l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+ if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+ if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+ do 101, p = 3, 5
+ do 101, q = 2, 6
+ do 101, r = 1, 7
+ l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+ l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+ do 102, p = 1, 5
+ do 102, q = 4, 6
+ l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+ call check (size (e, 1), 2, l)
+ call check (size (e, 2), 3, l)
+ call check (size (e, 3), 7, l)
+ call check (size (e), 42, l)
+ call check (size (f, 1), 2, l)
+ call check (size (f, 2), 5, l)
+ call check (size (f, 3), 7, l)
+ call check (size (f), 70, l)
+ call check (size (g, 1), 5, l)
+ call check (size (g, 2), 5, l)
+ call check (size (g), 25, l)
+ call check (size (h, 1), 5, l)
+ call check (size (h, 2), 5, l)
+ call check (size (h), 25, l)
+ call check (size (i, 1), 3, l)
+ call check (size (i, 2), 5, l)
+ call check (size (i, 3), 7, l)
+ call check (size (i), 105, l)
+ call check (size (j, 1), 4, l)
+ call check (size (j, 2), 5, l)
+ call check (size (j, 3), 7, l)
+ call check (size (j), 140, l)
+ call check (size (k, 1), 5, l)
+ call check (size (k, 2), 1, l)
+ call check (size (k, 3), 3, l)
+ call check (size (k), 15, l)
+ if (l) then
+!$omp atomic
+ err = err + 1
+ end if
+!$omp end task
+ c = ''
+ d = ''
+ e(:, :, :) = 199
+ f(:, :, :) = 198
+ g(:, :) = ''
+ h(:, :) = ''
+ i(:, :, :) = 7.0
+ j(:, :, :) = 8.0
+ k(:, :, :) = 9
+ s = ''
+ t(:, :, :) = 10
+ u(:, :, :) = 11
+ v(:, :) = ''
+ end subroutine foo
+
+ subroutine test
+ character (len = 12) :: c
+ character (len = 7) :: d
+ integer, dimension (2, 3:5, 7) :: e
+ integer, dimension (2, 3:7, 7) :: f
+ character (len = 12), dimension (5, 3:7) :: g
+ character (len = 7), dimension (5, 3:7) :: h
+ real, dimension (3:5, 2:6, 1:7) :: i
+ double precision, dimension (3:6, 2:6, 1:7) :: j
+ integer, dimension (1:5, 7:7, 4:6) :: k
+ integer :: p, q, r
+ c = 'abcdefghijkl'
+ d = 'ABCDEFG'
+ forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+ forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+ forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+ forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+ forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+ forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+ forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+ forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+ forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+ call foo (c, d, e, f, g, h, i, j, k, 7)
+ end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla4.f90 b/libgomp/testsuite/libgomp.fortran/vla4.f90
index 58caabc6248..cdd4849b6ad 100644
--- a/libgomp/testsuite/libgomp.fortran/vla4.f90
+++ b/libgomp/testsuite/libgomp.fortran/vla4.f90
@@ -94,7 +94,7 @@ contains
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
-!$omp barrier
+!$omp barrier ! { dg-warning "may not be closely nested" }
y = ''
if (x .eq. 0) y = '0'
if (x .eq. 1) y = '1'
diff --git a/libgomp/testsuite/libgomp.fortran/vla5.f90 b/libgomp/testsuite/libgomp.fortran/vla5.f90
index 5c889f9923a..9b611505219 100644
--- a/libgomp/testsuite/libgomp.fortran/vla5.f90
+++ b/libgomp/testsuite/libgomp.fortran/vla5.f90
@@ -66,7 +66,7 @@ contains
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
-!$omp barrier
+!$omp barrier ! { dg-warning "may not be closely nested" }
y = ''
if (x .eq. 0) y = '0'
if (x .eq. 1) y = '1'