diff options
| author | Rong Xu <xur@google.com> | 2014-07-21 16:47:22 -0700 |
|---|---|---|
| committer | Rong Xu <xur@google.com> | 2014-07-29 15:31:03 -0700 |
| commit | 38a8aecfb882072900434499696b5c32a2274515 (patch) | |
| tree | 2aac97f0ae24b03cd98c1a06e989c031c173f889 /gcc-4.9/gcc/testsuite/gfortran.dg | |
| parent | c231900e5dcc14d8296bd9f62b45997a49d4d5e7 (diff) | |
| download | toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.tar.gz toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.tar.bz2 toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.zip | |
[4.9] Switch gcc-4.9 to use google/gcc-4_9 branch.
This source drop uses svn version r212828 of google/gcc-4.9 branch.
We also cherry-picked r213062, r213063 and r213064 to fix windows
build issues.
All gcc-4.9 patches before July 3rd are ported to google/gcc-4.9.
The following prior commits has not been merged to google branch yet.
(They are included in this commit).
e7af147f979e657fe2df00808e5b4319b0e088c6,
baf87df3cb2683649ba7e9872362a7e721117c23, and
c231900e5dcc14d8296bd9f62b45997a49d4d5e7.
Change-Id: I4bea3ea470387ff751c2be4cb0d4a12059b9299b
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg')
42 files changed, 2214 insertions, 48 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 new file mode 100644 index 000000000..48f6dd216 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! Test the fix for PR61459 and PR58883. +! +! Contributed by John Wingate <johnww@tds.net> +! and Tao Song <songtao.thu@gmail.com> +! +module a + + implicit none + private + public :: f_segfault, f_segfault_plus, f_workaround + integer, dimension(2,2) :: b = reshape([1,-1,1,1],[2,2]) + +contains + + function f_segfault(x) + real, dimension(:), allocatable :: f_segfault + real, dimension(:), intent(in) :: x + allocate(f_segfault(2)) + f_segfault = matmul(b,x) + end function f_segfault + +! Sefaulted without the ALLOCATE as well. + function f_segfault_plus(x) + real, dimension(:), allocatable :: f_segfault_plus + real, dimension(:), intent(in) :: x + f_segfault_plus = matmul(b,x) + end function f_segfault_plus + + function f_workaround(x) + real, dimension(:), allocatable :: f_workaround + real, dimension(:), intent(in) :: x + real, dimension(:), allocatable :: tmp + allocate(f_workaround(2),tmp(2)) + tmp = matmul(b,x) + f_workaround = tmp + end function f_workaround + +end module a + +program main + use a + implicit none + real, dimension(2) :: x = 1.0, y +! PR61459 + y = f_workaround (x) + if (any (f_segfault (x) .ne. y)) call abort + if (any (f_segfault_plus (x) .ne. y)) call abort +! PR58883 + if (any (foo () .ne. reshape([1,2,3,4,5,6,7,8],[2,4]))) call abort +contains + function foo() + integer, allocatable :: foo(:,:) + integer, allocatable :: temp(:) + + temp = [1,2,3,4,5,6,7,8] + foo = reshape(temp,[2,4]) + end function +end program main diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_14.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_14.f90 new file mode 100644 index 000000000..3d878c756 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_14.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! PR61173.f90 Bogus END condition +module bd + character(len=25, kind=1), dimension(:), allocatable, save :: source + contains + subroutine init_data + allocate(source(2)) + source=[" 1 1 1 ", " 4 4 4 "] + end subroutine init_data +end module bd +program read_internal + use bd + integer :: x(6),i + + call init_data + read(source,*) (x(i), i=1,6) + if (any(x/=[1,1,1,4,4,4])) call abort +end program read_internal diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_15.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_15.f90 new file mode 100644 index 000000000..df497dc02 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_15.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR61499 +program read_internal + + integer :: x(9),i,iostat + character(len=512) :: iomsg + character(kind=1,len=30), dimension(:), allocatable, save :: source + allocate(source(3)) + source=[" 1 1 -1"," 1 -1 1"," -1 1 1"] !This fails + read(source,*) (x(i), i=1,6) +end program read_internal diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_16.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_16.f90 new file mode 100644 index 000000000..46814ae5d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_16.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! PR61640 KIND=4 Character Array Internal Unit Read Fail +program read_internal + integer :: x(9),i + integer :: y(9) + character(kind=4,len=30), dimension(3) :: source + + y = reshape ((/ 1,1,-1,1,-1,1,-1,1,1 /), shape(x)) + source=[4_" 1 1 -1",4_" 1 -1 1",4_" -1 1 1"] + !print *, (trim(source(i)), i=1,3) + read(source,*) (x(i), i=1,9) ! This read fails for KIND=4 character + if (any(x /= y )) call abort +end program read_internal diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/associate_16.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_16.f90 new file mode 100644 index 000000000..9129388b2 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_16.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! PR 60834 - this used to ICE. + +module m + implicit none + type :: t + real :: diffusion=1. + end type +contains + subroutine solve(this, x) + class(t), intent(in) :: this + real, intent(in) :: x(:) + integer :: i + integer, parameter :: n(1:5)=[(i,i=1, 5)] + + associate( nu=>this%diffusion) + associate( exponential=>exp(-(x(i)-n) )) + do i = 1, size(x) + end do + end associate + end associate + end subroutine solve +end module m diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/associate_17.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_17.f90 new file mode 100644 index 000000000..5c39cf062 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_17.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! Test the fix for PR61406 +! Contributed by Adam Hirst <adam@aphirst.karoo.co.uk> +program test + implicit none + real :: theta = 1.0 + + associate (n => [cos(theta), sin(theta)]) + if (abs (norm2(n) - 1.0) .gt. 1.0e-4) call abort + end associate + +end program test diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_15.f03 index 7d1d4d718..d3a123259 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_15.f03 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_15.f03 @@ -1,4 +1,5 @@ ! { dg-do run } +! { dg-options "-fdump-tree-original" } ! ! Tests the fixes for three bugs with the same underlying cause. All are regressions ! that come about because class array elements end up with a different tree type @@ -114,3 +115,5 @@ subroutine pr54992 ! This test remains as the original. bh => bhGet(b,instance=2) if (loc (b) .ne. loc(bh%hostNode)) call abort end +! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/cray_pointers_10.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/cray_pointers_10.f90 new file mode 100644 index 000000000..1ac98f3ea --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/cray_pointers_10.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! { dg-options "-fcray-pointer" } +! +! PR fortran/45187 +! +module foo + implicit none + real :: a + pointer(c_a, a) +end module foo + +program test + use foo + real :: z + c_a = loc(z) + a = 42 + if (z /= 42) call abort +end program test diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 index a5337ca3b..6134a5625 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 @@ -1,6 +1,6 @@ ! { dg-require-effective-target fortran_large_real } -! { dg-do run { xfail powerpc*-apple-darwin* powerpc*-*-linux* } } -! Test XFAILed on these platforms because the system's printf() lacks +! { dg-do run { xfail powerpc*-apple-darwin* } } +! Test XFAILed on this platform because the system's printf() lacks ! proper support for denormalized long doubles. See PR24685 ! ! This tests that the default formats for formatted I/O of reals are diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_25.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_25.f90 new file mode 100644 index 000000000..cdbec4cac --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_25.f90 @@ -0,0 +1,55 @@ +! { dg-do run } +! +! PR fortran/58880 +! PR fortran/60495 +! +! Contributed by Andrew Benson and Janus Weil +! + +module gn + implicit none + type sl + integer, allocatable, dimension(:) :: lv + contains + final :: sld + end type + type :: nde + type(sl) :: r + end type nde + + integer :: cnt = 0 + +contains + + subroutine sld(s) + type(sl) :: s + cnt = cnt + 1 + ! print *,'Finalize sl' + end subroutine + subroutine ndm(s) + type(nde), intent(inout) :: s + type(nde) :: i + i=s + end subroutine ndm +end module + +program main + use gn + type :: nde2 + type(sl) :: r + end type nde2 + type(nde) :: x + + cnt = 0 + call ndm(x) + if (cnt /= 2) call abort() + + cnt = 0 + call ndm2() + if (cnt /= 3) call abort() +contains + subroutine ndm2 + type(nde2) :: s,i + i=s + end subroutine ndm2 +end program main diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 new file mode 100644 index 000000000..b6e20b9ce --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 @@ -0,0 +1,19 @@ + integer :: i, j + integer, dimension (10, 10) :: a +!$omp parallel do default(none)proc_bind(master)shared(a) + do i = 1, 10 + j = 4 + do j = 1, 10 + a(i, j) = i + j + end do + j = 8 + end do +!$omp end parallel do +!$omp parallel proc_bind (close) +!$omp parallel default(none) proc_bind (spread) firstprivate(a) private (i) + do i = 1, 10 + a(i, i) = i + enddo +!$omp end parallel +!$omp endparallel +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 index 2a762c77b..bc06cc866 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 @@ -14,7 +14,7 @@ CONTAINS TYPE(t), SAVE :: a !$omp threadprivate(a) - !$omp parallel copyin(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel copyin(a) ! do something !$omp end parallel END SUBROUTINE @@ -22,7 +22,7 @@ CONTAINS SUBROUTINE test_copyprivate() TYPE(t) :: a - !$omp single ! { dg-error "has ALLOCATABLE components" } + !$omp single ! do something !$omp end single copyprivate (a) END SUBROUTINE @@ -30,7 +30,7 @@ CONTAINS SUBROUTINE test_firstprivate TYPE(t) :: a - !$omp parallel firstprivate(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel firstprivate(a) ! do something !$omp end parallel END SUBROUTINE @@ -39,7 +39,7 @@ CONTAINS TYPE(t) :: a INTEGER :: i - !$omp parallel do lastprivate(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel do lastprivate(a) DO i = 1, 1 END DO !$omp end parallel do @@ -49,7 +49,7 @@ CONTAINS TYPE(t) :: a(10) INTEGER :: i - !$omp parallel do reduction(+: a) ! { dg-error "must be of numeric type" } + !$omp parallel do reduction(+: a) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } DO i = 1, SIZE(a) END DO !$omp end parallel do diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 index f67c91c21..598c90420 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 @@ -5,7 +5,7 @@ !$OMP PARALLEL DO REDUCTION(MAX: M) ! MAX is no longer the ! intrinsic so this ! is non-conforming -! { dg-error "is not INTRINSIC procedure name" "" { target *-*-* } 5 } */ +! { dg-error "OMP DECLARE REDUCTION max not found" "" { target *-*-* } 5 } */ DO I = 1, 100 CALL SUB(M,I) END DO diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/associate1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/associate1.f90 new file mode 100644 index 000000000..abc5ae95a --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/associate1.f90 @@ -0,0 +1,83 @@ +! { dg-do compile } + +program associate1 + type dl + integer :: i + end type + type dt + integer :: i + real :: a(3, 3) + type(dl) :: c(3, 3) + end type + integer :: v, i, j + real :: a(3, 3) + type(dt) :: b(3) + i = 1 + j = 2 + associate(k => v, l => a(i, j), m => a(i, :)) + associate(n => b(j)%c(:, :)%i, o => a, p => b) +!$omp parallel shared (l) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel reduction (+: k) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel do firstprivate (k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do lastprivate (n) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do private (o) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do shared (p) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp task private (k) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp task shared (l) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp task firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp do private (l) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp do reduction (*: k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp sections private(o) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp end sections +!$omp parallel sections firstprivate(p) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp endparallelsections +!$omp parallelsections lastprivate(m) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp endparallelsections +!$omp sections reduction(+:k) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp end sections +!$omp simd private (l) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd lastprivate (m) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd reduction (+: k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd linear (k : 2) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + k = k + 2 + end do + end associate + end associate +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 new file mode 100644 index 000000000..d6ae7c9c8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } + +subroutine fn1 (x) + integer :: x +!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Unclassifiable OpenMP directive" } +end subroutine fn1 +subroutine fn2 (x) +!$omp declare simd (fn100) ! { dg-error "should refer to containing procedure" } +end subroutine fn2 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 new file mode 100644 index 000000000..bd6d26a38 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } + +subroutine foo (x) + integer :: x(5, *) +!$omp parallel +!$omp single +!$omp task depend(in:x(:,5)) +!$omp end task +!$omp task depend(in:x(5,:)) ! { dg-error "Rightmost upper bound of assumed size array section|proper array section" } +!$omp end task +!$omp end single +!$omp end parallel +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 new file mode 100644 index 000000000..f2a2e98fd --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } + +subroutine foo (x) + integer, pointer, intent (in) :: x + integer :: i +!$omp parallel private (x) ! { dg-error "INTENT.IN. POINTER" } +!$omp end parallel +!$omp parallel do lastprivate (x) ! { dg-error "INTENT.IN. POINTER" } + do i = 1, 10 + end do +!$omp simd linear (x) ! { dg-error "INTENT.IN. POINTER" } + do i = 1, 10 + end do +!$omp single ! { dg-error "INTENT.IN. POINTER" } +!$omp end single copyprivate (x) +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 new file mode 100644 index 000000000..83204791d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } +! +! PR fortran/60127 +! +! OpenMP 4.0 doesn't permit DO CONCURRENT (yet) +! + +!$omp do +do concurrent(i=1:5) ! { dg-error "OMP DO cannot be a DO CONCURRENT loop" } +print *, 'Hello' +end do +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 new file mode 100644 index 000000000..c9ce70c4f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 @@ -0,0 +1,137 @@ +! { dg-do compile } +! { dg-options "-fno-openmp -fopenmp-simd -fdump-tree-original -O2" } + +!$omp declare reduction (foo:integer:omp_out = omp_out + omp_in) + interface + integer function foo (x, y) + integer, value :: x, y +!$omp declare simd (foo) linear (y : 2) + end function foo + end interface + integer :: i, a(64), b, c + integer, save :: d +!$omp threadprivate (d) + d = 5 + a = 6 +!$omp simd + do i = 1, 64 + a(i) = foo (a(i), 2 * i) + end do + b = 0 + c = 0 +!$omp simd reduction (+:b) reduction (foo:c) + do i = 1, 64 + b = b + a(i) + c = c + a(i) * 2 + end do + print *, b + b = 0 +!$omp parallel +!$omp do simd schedule(static, 4) safelen (8) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp end parallel + print *, b + b = 0 +!$omp parallel do simd schedule(static, 4) safelen (8) & +!$omp num_threads (4) if (.true.) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do + print *, b + b = 0 +!$omp parallel +!$omp do simd schedule(static, 4) safelen (8) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp enddosimd +!$omp end parallel + print *, b + b = 0 +!$omp parallel do simd schedule(static, 4) safelen (8) & +!$omp num_threads (4) if (.true.) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp end parallel do simd +!$omp atomic seq_cst + b = b + 1 +!$omp end atomic +!$omp barrier +!$omp parallel private (i) +!$omp cancellation point parallel +!$omp critical (bar) + b = b + 1 +!$omp end critical (bar) +!$omp flush(b) +!$omp single + b = b + 1 +!$omp end single +!$omp do ordered + do i = 1, 10 + !$omp atomic + b = b + 1 + !$omp end atomic + !$omp ordered + print *, b + !$omp end ordered + end do +!$omp end do +!$omp master + b = b + 1 +!$omp end master +!$omp cancel parallel +!$omp end parallel +!$omp parallel do schedule(runtime) num_threads(8) + do i = 1, 10 + print *, b + end do +!$omp end parallel do +!$omp sections +!$omp section + b = b + 1 +!$omp section + c = c + 1 +!$omp end sections + print *, b +!$omp parallel sections firstprivate (b) if (.true.) +!$omp section + b = b + 1 +!$omp section + c = c + 1 +!$omp endparallelsections +!$omp workshare + b = 24 +!$omp end workshare +!$omp parallel workshare num_threads (2) + b = b + 1 + c = c + 1 +!$omp end parallel workshare + print *, b +!$omp parallel +!$omp single +!$omp taskgroup +!$omp task firstprivate (b) + b = b + 1 +!$omp taskyield +!$omp end task +!$omp task firstprivate (b) + b = b + 1 +!$omp end task +!$omp taskwait +!$omp end taskgroup +!$omp end single +!$omp end parallel + print *, a, c +end + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 6 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 new file mode 100644 index 000000000..4b2046a58 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fopenmp-simd -fdump-tree-original -O2" } + +include 'openmp-simd-1.f90' + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 39 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp for" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp parallel" 9 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp taskgroup" 1 "original" } } +! Includes the above taskgroup +! { dg-final { scan-tree-dump-times "pragma omp task" 3 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp critical" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp atomic" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp sections" 2 "original" } } +! Includes the above sections +! { dg-final { scan-tree-dump-times "pragma omp section" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp single" 4 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp ordered" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp master" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_barrier" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancellation_point" 1 "original" } } +! Includes the above cancellation point +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskyield" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 new file mode 100644 index 000000000..2dece895f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fno-openmp-simd -fdump-tree-original -O2" } + +include 'openmp-simd-1.f90' + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 39 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp for" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp parallel" 9 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp taskgroup" 1 "original" } } +! Includes the above taskgroup +! { dg-final { scan-tree-dump-times "pragma omp task" 3 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp critical" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp atomic" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp sections" 2 "original" } } +! Includes the above sections +! { dg-final { scan-tree-dump-times "pragma omp section" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp single" 4 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp ordered" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp master" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_barrier" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancellation_point" 1 "original" } } +! Includes the above cancellation point +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskyield" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 new file mode 100644 index 000000000..d993429a7 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + procedure(foo), pointer :: ptr + integer :: i + ptr => foo +!$omp do reduction (+ : ptr) ! { dg-error "Procedure pointer|not found" } + do i = 1, 10 + end do +!$omp simd linear (ptr) ! { dg-error "must be INTEGER" } + do i = 1, 10 + end do +contains + subroutine foo + end subroutine +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 index 4912f7178..cdc530bf0 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 @@ -60,73 +60,73 @@ common /blk/ i1 !$omp end parallel !$omp parallel reduction (*:ia1) ! { dg-error "Assumed size" } !$omp end parallel -!$omp parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$omp parallel reduction (+:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$omp parallel reduction (*:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" } +!$omp parallel reduction (-:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" } +!$omp parallel reduction (+:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" } +!$omp parallel reduction (*:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:i3) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:ia2) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:r1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.neqv.:ra1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:d1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:da1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.neqv.:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:r1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:r1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:ra1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:d1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:da1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:da1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:c1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:la1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:a1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel end subroutine diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 index 2c113893a..9cab6d57d 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 @@ -16,7 +16,7 @@ subroutine f1 integer :: i, ior ior = 6 i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } !$omp end parallel end subroutine f1 subroutine f2 @@ -27,7 +27,7 @@ subroutine f2 end function end interface i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = ior (i, 3) !$omp end parallel end subroutine f2 @@ -50,7 +50,7 @@ subroutine f5 use mreduction3 integer :: i i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = ior (i, 7) !$omp end parallel end subroutine f5 @@ -58,7 +58,7 @@ subroutine f6 use mreduction3 integer :: i i = 6 -!$omp parallel reduction (iand:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (iand:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = iand (i, 18) !$omp end parallel end subroutine f6 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target1.f90 new file mode 100644 index 000000000..14db4970b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target1.f90 @@ -0,0 +1,520 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module target1 + interface + subroutine dosomething (a, n, m) + integer :: a (:), n, m + !$omp declare target + end subroutine dosomething + end interface +contains + subroutine foo (n, o, p, q, r, pp) + integer :: n, o, p, q, r, s, i, j + integer :: a (2:o) + integer, pointer :: pp + !$omp target data device (n + 1) if (n .ne. 6) map (tofrom: n, r) + !$omp target device (n + 1) if (n .ne. 6) map (from: n) map (alloc: a(2:o)) + call dosomething (a, n, 0) + !$omp end target + !$omp target teams device (n + 1) num_teams (n + 4) thread_limit (n * 2) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp end target teams + !$omp target teams distribute device (n + 1) num_teams (n + 4) collapse (2) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp target teams distribute device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams distribute + !$omp target teams distribute parallel do device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp target teams distribute parallel do device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end target teams distribute parallel do + !$omp target teams distribute parallel do simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp target teams distribute parallel do simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end target teams distribute parallel do simd + !$omp target teams distribute simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & lastprivate (s) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp target teams distribute simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) lastprivate (s) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end target teams distribute simd + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams num_teams (n + 4) thread_limit (n * 2) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp end teams + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute num_teams (n + 4) collapse (2) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute num_teams (n + 4) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end teams distribute + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do num_teams (n + 4) & + !$omp & if (n .ne. 6) default(shared) ordered schedule (static, 8) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do num_teams (n + 4)if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end teams distribute parallel do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end teams distribute parallel do simd + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute simd default(shared) safelen(8) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & lastprivate (s) num_teams (n + 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute simd default(shared) aligned (pp:4) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end teams distribute simd + !$omp end target + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction ( + : r ) + !$omp distribute collapse (2) firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end distribute + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if (n .ne. 6) default(shared) & + !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end distribute parallel do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) safelen(8) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute parallel do simd + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd safelen(8) lastprivate(s) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd aligned (pp:4) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute simd + !$omp end target teams + !$omp end target data + end subroutine + subroutine bar (n, o, p, r, pp) + integer :: n, o, p, q, r, s, i, j + integer :: a (2:o) + integer, pointer :: pp + common /blk/ i, j, q + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction ( + : r ) + !$omp distribute collapse (2) firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end distribute + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if (n .ne. 6) default(shared) & + !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end distribute parallel do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) safelen(8) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute parallel do simd + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd safelen(8) lastprivate(s) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd aligned (pp:4) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute simd + !$omp end target teams + end subroutine +end module diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target2.f90 new file mode 100644 index 000000000..7521331fc --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target2.f90 @@ -0,0 +1,74 @@ +! { dg-do compile } +! { dg-options "-fopenmp -ffree-line-length-160" } + +subroutine foo (n, s, t, u, v, w) + integer :: n, i, s, t, u, v, w + common /bar/ i + !$omp simd safelen(s + 1) + do i = 1, n + end do + !$omp do schedule (static, t * 2) + do i = 1, n + end do + !$omp do simd safelen(s + 1) schedule (static, t * 2) + do i = 1, n + end do + !$omp parallel do schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp parallel do simd safelen(s + 1) schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp distribute dist_schedule (static, v + 8) + do i = 1, n + end do + !$omp distribute simd dist_schedule (static, v + 8) safelen(s + 1) + do i = 1, n + end do + !$omp distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) + do i = 1, n + end do + !$omp target + !$omp teams distribute dist_schedule (static, v + 8) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target teams distribute dist_schedule (static, v + 8) num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) num_teams (w + 8) + do i = 1, n + end do +end subroutine diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target3.f90 new file mode 100644 index 000000000..53a9682bf --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/target3.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +subroutine foo (r) + integer :: i, r + !$omp target + !$omp target teams distribute parallel do reduction (+: r) ! { dg-warning "target construct inside of target region" } + do i = 1, 10 + r = r + 1 + end do + !$omp end target +end subroutine diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr1.f90 new file mode 100644 index 000000000..84601310c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr1.f90 @@ -0,0 +1,41 @@ +! { dg-do compile } + +subroutine f1 +!$omp declare reduction (.le.:integer:omp_out = omp_out + omp_in) ! { dg-error "Invalid operator for" } +end subroutine f1 +subroutine f2 +!$omp declare reduction (bar:real(kind=4):omp_out = omp_out + omp_in) + real(kind=4) :: r + integer :: i + r = 0.0 +!$omp parallel do reduction (bar:r) + do i = 1, 10 + r = r + i + end do +!$omp parallel do reduction (foo:r) ! { dg-error "foo not found" } + do i = 1, 10 + r = r + i + end do +!$omp parallel do reduction (.gt.:r) ! { dg-error "cannot be used as a defined operator" } + do i = 1, 10 + r = r + i + end do +end subroutine f2 +subroutine f3 +!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "Unclassifiable OpenMP directive" } +end subroutine f3 +subroutine f4 +!$omp declare reduction (foo:integer:a => null()) ! { dg-error "Invalid character in name" } +!$omp declare reduction (foo:integer:omp_out = omp_in + omp_out) & +!$omp & initializer(a => null()) ! { dg-error "Invalid character in name" } +end subroutine f4 +subroutine f5 + integer :: a, b +!$omp declare reduction (foo:integer:a = b + 1) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" } +!$omp declare reduction (bar:integer:omp_out = omp_out * omp_in) & +!$omp & initializer(b = a + 1) ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" } +end subroutine f5 +subroutine f6 +!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_orig=omp_priv) +end subroutine f6 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr2.f90 new file mode 100644 index 000000000..7038d1869 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr2.f90 @@ -0,0 +1,53 @@ +! { dg-do compile } + +subroutine f6 +!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & ! { dg-error "Unclassifiable OpenMP directive" } +!$omp & initializer (omp_priv (omp_orig)) +end subroutine f6 +subroutine f7 + integer :: a +!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (bar:real:omp_out = omp_out.or.omp_in) ! { dg-error "Operands of logical operator" } +!$omp declare reduction (baz:real:omp_out = omp_out + omp_in) +!$omp & initializer (a (omp_priv, omp_orig)) ! { dg-error "Unclassifiable OpenMP directive" } + real :: r + r = 0.0 +!$omp parallel reduction (bar:r) +!$omp end parallel +end subroutine f7 +subroutine f8 + interface + subroutine f8a (x) + integer :: x + end subroutine f8a + end interface +!$omp declare reduction (baz:integer:omp_out = omp_out + omp_in) & +!$omp & initializer (f8a (omp_orig)) ! { dg-error "One of actual subroutine arguments in INITIALIZER clause" } +!$omp declare reduction (foo:integer:f8a) ! { dg-error "is not a variable" } +!$omp declare reduction (bar:integer:omp_out = omp_out - omp_in) & +!$omp & initializer (f8a) ! { dg-error "is not a variable" } +end subroutine f8 +subroutine f9 + type dt ! { dg-error "which is not consistent with the CALL" } + integer :: x = 0 + integer :: y = 0 + end type dt + integer :: i +!$omp declare reduction (foo:integer:dt (omp_out, omp_in)) ! { dg-error "which is not consistent with the CALL" } +!$omp declare reduction (bar:integer:omp_out = omp_out + omp_in) & +!$omp & initializer (dt (omp_priv, omp_orig)) ! { dg-error "which is not consistent with the CALL" } + i = 0 +!$omp parallel reduction (foo : i) +!$omp end parallel +!$omp parallel reduction (bar : i) +!$omp end parallel +end subroutine f9 +subroutine f10 + integer :: a, b +!$omp declare reduction(foo:character(len=64) & +!$omp & :omp_out(a:b) = omp_in(a:b)) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" } +!$omp declare reduction(bar:character(len=16) & +!$omp & :omp_out = trim(omp_out) // omp_in) & +!$omp & initializer (omp_priv(a:b) = ' ') ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" } +end subroutine f10 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr3.f90 new file mode 100644 index 000000000..a4feaddd1 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr3.f90 @@ -0,0 +1,75 @@ +! { dg-do compile } + +subroutine f1 + type dt + logical :: l = .false. + end type + type dt2 + logical :: l = .false. + end type +!$omp declare reduction (foo:integer(kind = 4) & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (foo:integer(kind = 4) : & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & omp_out = omp_out + omp_in) +!$omp declare reduction (bar:integer, & +!$omp & real:omp_out = omp_out + omp_in) +!$omp declare reduction (baz:integer,real,integer & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp & : omp_out = omp_out + omp_in) +!$omp declare reduction (id1:dt,dt2:omp_out%l=omp_out%l & +!$omp & .or.omp_in%l) +!$omp declare reduction (id2:dt,dt:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp & .or.omp_in%l) +!$omp declare reduction (id3:dt2,dt:omp_out%l=omp_out%l & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & .or.omp_in%l) +!$omp declare reduction (id3:dt2:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & .or.omp_in%l) +end subroutine f1 +subroutine f2 + interface + subroutine f2a (x, y, z) + character (len = *) :: x, y + logical :: z + end subroutine + end interface + interface f2b + subroutine f2b (x, y, z) + character (len = *, kind = 1) :: x, y + logical :: z + end subroutine + subroutine f2c (x, y, z) + character (kind = 4, len = *) :: x, y + logical :: z + end subroutine + end interface +!$omp declare reduction (foo:character(len=*): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (bar:character(len=:): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=4): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=5): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=6): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id:character(len=*): & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id: & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & character(len=:) : f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp (id2:character(len=*), character(len=:): & +!$omp f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id3:character(len=*, kind = 1), character(kind=4, len=:): & +!$omp f2b (omp_out, omp_in, .false.)) & +!$omp & initializer (f2b (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id4:character(kind=4, len=4), character(kind =1, len=4): & +!$omp f2b (omp_out, omp_in, .false.)) & +!$omp & initializer (f2b (omp_priv, omp_orig, .true.)) +end subroutine f2 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr4.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr4.f90 new file mode 100644 index 000000000..b48c1090f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr4.f90 @@ -0,0 +1,74 @@ +! { dg-do compile } + +subroutine f3 +!$omp declare reduction ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction foo ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo:integer) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=0) initializer(omp_priv=0) ! { dg-error "Unexpected junk after" } +end subroutine f3 +subroutine f4 + implicit integer (o) + implicit real (b) +!$omp declare reduction (foo:integer:omp_priv(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine omp_priv" } +!$omp declare reduction (foo:real:bar(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine bar used" } +!$omp declare reduction (bar:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_out (omp_priv)) ! { dg-error "Implicitly declared subroutine omp_out used" } +!$omp declare reduction (bar:real:omp_out=omp_out+omp_in) & +!$omp & initializer(bar (omp_priv, omp_orig)) ! { dg-error "Implicitly declared subroutine bar used" } +!$omp declare reduction (id1:integer:omp_out=omp_orig(omp_out,omp_in)) ! { dg-error "Implicitly declared function omp_orig used" } +!$omp declare reduction (id1:real:omp_out=foo(omp_out,omp_in)) ! { dg-error "Implicitly declared function foo used" } +!$omp declare reduction (id2:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv = omp_in (omp_orig)) ! { dg-error "Implicitly declared function omp_in used" } +!$omp declare reduction (id2:real:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv = baz (omp_orig)) ! { dg-error "Implicitly declared function baz used" } + integer :: i + real :: r + i = 0 + r = 0 +!$omp parallel reduction (foo: i, r) +!$omp end parallel +!$omp parallel reduction (bar: i, r) +!$omp end parallel +!$omp parallel reduction (id1: i, r) +!$omp end parallel +!$omp parallel reduction (id2: i, r) +!$omp end parallel +end subroutine f4 +subroutine f5 + interface + subroutine f5a (x, *, y) + double precision :: x, y + end subroutine f5a + end interface +!$omp declare reduction (foo:double precision: & ! { dg-error "Subroutine call with alternate returns in combiner" } +!$omp & f5a (omp_out, *10, omp_in)) +!$omp declare reduction (bar:double precision: & +!$omp omp_out = omp_in + omp_out) & +!$omp & initializer (f5a (omp_priv, *20, omp_orig)) ! { dg-error "Subroutine call with alternate returns in INITIALIZER clause" } +10 continue +20 continue +end subroutine f5 +subroutine f6 + integer :: a +!$omp declare reduction(foo:character(len=a*2) & ! { dg-error "cannot appear in the expression|not constant" } +!$omp & :omp_out=trim(omp_out)//omp_in) & +!$omp & initializer(omp_priv=' ') +end subroutine f6 +subroutine f7 + type dt1 + integer :: a = 1 + integer :: b + end type + type dt2 + integer :: a = 2 + integer :: b = 3 + end type + type dt3 + integer :: a + integer :: b + end type dt3 +!$omp declare reduction(foo:dt1,dt2:omp_out%a=omp_out%a+omp_in%a) +!$omp declare reduction(foo:dt3:omp_out%a=omp_out%a+omp_in%a) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" } +end subroutine f7 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr5.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr5.f90 new file mode 100644 index 000000000..aebeee3a2 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr5.f90 @@ -0,0 +1,59 @@ +! { dg-do compile } + +module udr5m1 + type dt + real :: r + end type dt +end module udr5m1 +module udr5m2 + use udr5m1 + interface operator(+) + module procedure addm2 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(.myadd.) + module procedure addm2 + end interface +contains + type(dt) function addm2 (x, y) + type(dt), intent (in):: x, y + addm2%r = x%r + y%r + end function +end module udr5m2 +module udr5m3 + use udr5m1 + interface operator(.myadd.) + module procedure addm3 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm3 + end interface +contains + type(dt) function addm3 (x, y) + type(dt), intent (in):: x, y + addm3%r = x%r + y%r + end function +end module udr5m3 +subroutine f1 + use udr5m2 + type(dt) :: d, e + integer :: i + d=dt(0.0) + e = dt (0.0) +!$omp parallel do reduction (+ : d) reduction ( .myadd. : e) + do i=1,100 + d=d+dt(i) + e=e+dt(i) + end do +end subroutine f1 +subroutine f2 + use udr5m3 ! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" } + use udr5m2 ! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" } +end subroutine f2 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr6.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr6.f90 new file mode 100644 index 000000000..92fc5bb1b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr6.f90 @@ -0,0 +1,205 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1000 -fopenmp -ffree-line-length-160" } + +module udr6 + type dt + integer :: i + end type +end module udr6 +subroutine f1 + use udr6, only : dt +!$omp declare reduction (+:integer:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:real(kind=4):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:double precision:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (+:complex:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:complex(kind=8):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(+) + function addf1 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: addf1 + end function + end interface +end subroutine f1 +subroutine f2 + use udr6, only : dt + interface operator(-) + function subf2 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: subf2 + end function + end interface +!$omp declare reduction (-:integer:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:real(kind=4):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:double precision:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (-:complex:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:complex(kind=8):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f2 +subroutine f3 + use udr6, only : dt + interface operator(*) + function mulf3 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: mulf3 + end function + end interface +!$omp declare reduction (*:integer:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:real(kind=4):omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:double precision:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out * omp_in) +!$omp declare reduction (*:complex:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:complex(kind=8):omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f3 +subroutine f4 + use udr6, only : dt + interface operator(.and.) + function andf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: andf4 + end function + end interface +!$omp declare reduction (.neqv.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.or.) + function orf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: orf4 + end function + end interface +!$omp declare reduction (.eqv.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.eqv.) + function eqvf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: eqvf4 + end function + end interface +!$omp declare reduction (.or.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.neqv.) + function neqvf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: neqvf4 + end function + end interface +!$omp declare reduction (.and.:logical:omp_out = omp_out .and. omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f4 +subroutine f5 + use udr6, only : dt + interface operator(.and.) + function andf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: andf5 + end function + end interface +!$omp declare reduction (.neqv.:logical(kind =4):omp_out = omp_out .neqv. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.or.) + function orf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: orf5 + end function + end interface +!$omp declare reduction (.eqv.:logical(kind= 4):omp_out = omp_out .eqv. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.eqv.) + function eqvf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: eqvf5 + end function + end interface +!$omp declare reduction (.or.:logical(kind=4):omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.neqv.) + function neqvf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: neqvf5 + end function + end interface +!$omp declare reduction (.and.:logical(kind = 4):omp_out = omp_out .and. omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f5 +subroutine f6 +!$omp declare reduction (min:integer:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:integer:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (iand:integer:omp_out = iand (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ior:integer:omp_out = ior (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ieor:integer:omp_out = ieor (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:real:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:real:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:double precision:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:double precision:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +end subroutine f6 +subroutine f7 +!$omp declare reduction (min:integer(kind=2):omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:integer(kind=4):omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (iand:integer(kind=1):omp_out = iand (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ior:integer(kind=8):omp_out = ior (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ieor:integer(kind=4):omp_out = ieor (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:real(kind=4):omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:real(kind=4):omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:double precision:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:double precision:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +end subroutine f7 +subroutine f8 + integer :: min +!$omp declare reduction (min:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (min:real:omp_out = omp_out + omp_in) +!$omp declare reduction (min:double precision:omp_out = omp_out + omp_in) +end subroutine f8 +subroutine f9 + integer :: max +!$omp declare reduction (max:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (max:real:omp_out = omp_out + omp_in) +!$omp declare reduction (max:double precision:omp_out = omp_out + omp_in) +end subroutine f9 +subroutine f10 + integer :: iand +!$omp declare reduction (iand:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (iand:real:omp_out = omp_out + omp_in) +end subroutine f10 +subroutine f11 + integer :: ior +!$omp declare reduction (ior:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ior:real:omp_out = omp_out + omp_in) +end subroutine f11 +subroutine f12 + integer :: ieor +!$omp declare reduction (ieor:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ieor:real:omp_out = omp_out + omp_in) +end subroutine f12 +subroutine f13 +!$omp declare reduction (min:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (min:real:omp_out = omp_out + omp_in) +!$omp declare reduction (min:double precision:omp_out = omp_out + omp_in) + integer :: min +end subroutine f13 +subroutine f14 +!$omp declare reduction (max:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (max:real:omp_out = omp_out + omp_in) +!$omp declare reduction (max:double precision:omp_out = omp_out + omp_in) + integer :: max +end subroutine f14 +subroutine f15 +!$omp declare reduction (iand:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (iand:real:omp_out = omp_out + omp_in) + integer :: iand +end subroutine f15 +subroutine f16 +!$omp declare reduction (ior:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ior:real:omp_out = omp_out + omp_in) + integer :: ior +end subroutine f16 +subroutine f17 +!$omp declare reduction (ieor:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ieor:real:omp_out = omp_out + omp_in) + integer :: ieor +end subroutine f17 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr7.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr7.f90 new file mode 100644 index 000000000..230a3fc44 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr7.f90 @@ -0,0 +1,90 @@ +! { dg-do compile } + +module udr7m1 + type dt + real :: r + end type dt +end module udr7m1 +module udr7m2 + use udr7m1 + interface operator(+) + module procedure addm2 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(.myadd.) + module procedure addm2 + end interface + private + public :: operator(+), operator(.myadd.), dt +contains + type(dt) function addm2 (x, y) + type(dt), intent (in):: x, y + addm2%r = x%r + y%r + end function +end module udr7m2 +module udr7m3 + use udr7m1 + private + public :: operator(.myadd.), operator(+), dt + interface operator(.myadd.) + module procedure addm3 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm3 + end interface +contains + type(dt) function addm3 (x, y) + type(dt), intent (in):: x, y + addm3%r = x%r + y%r + end function +end module udr7m3 +module udr7m4 + use udr7m1 + private + interface operator(.myadd.) + module procedure addm4 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm4 + end interface +contains + type(dt) function addm4 (x, y) + type(dt), intent (in):: x, y + addm4%r = x%r + y%r + end function +end module udr7m4 +subroutine f1 + use udr7m2 + type(dt) :: d, e + integer :: i + d=dt(0.0) + e = dt (0.0) +!$omp parallel do reduction (+ : d) reduction ( .myadd. : e) + do i=1,100 + d=d+dt(i) + e=e+dt(i) + end do +end subroutine f1 +subroutine f2 + use udr7m3 ! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" } + use udr7m2 ! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" } +end subroutine f2 +subroutine f3 + use udr7m4 + use udr7m2 +end subroutine f3 +subroutine f4 + use udr7m3 + use udr7m4 +end subroutine f4 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr8.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr8.f90 new file mode 100644 index 000000000..e040b3d1e --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/gomp/udr8.f90 @@ -0,0 +1,351 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1000 -fopenmp" } + +module m +contains + function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + fn1 = x + 2 * y + end function + subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + x = y + end subroutine + function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + fn2 = x + end function + subroutine sub2 (x, y) + integer, intent(in) :: y + integer, intent(inout) :: x + x = x + y + end subroutine + function fn3 (x, y) + integer, intent(in) :: x(:), y(:) + integer :: fn3(lbound(x, 1):ubound(x, 1)) + fn3 = x + 2 * y + end function + subroutine sub3 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + x = y + end subroutine + function fn4 (x) + integer, intent(in) :: x(:) + integer :: fn4(lbound(x, 1):ubound(x, 1)) + fn4 = x + end function + subroutine sub4 (x, y) + integer, intent(in) :: y(:) + integer, intent(inout) :: x(:) + x = x + y + end subroutine + function fn5 (x, y) + integer, intent(in) :: x(10), y(10) + integer :: fn5(10) + fn5 = x + 2 * y + end function + subroutine sub5 (x, y) + integer, intent(in) :: y(10) + integer, intent(out) :: x(10) + x = y + end subroutine + function fn6 (x) + integer, intent(in) :: x(10) + integer :: fn6(10) + fn6 = x + end function + subroutine sub6 (x, y) + integer, intent(in) :: y(10) + integer, intent(inout) :: x(10) + x = x + y + end subroutine + function fn7 (x, y) + integer, allocatable, intent(in) :: x(:), y(:) + integer, allocatable :: fn7(:) + fn7 = x + 2 * y + end function + subroutine sub7 (x, y) + integer, allocatable, intent(in) :: y(:) + integer, allocatable, intent(out) :: x(:) + x = y + end subroutine + function fn8 (x) + integer, allocatable, intent(in) :: x(:) + integer, allocatable :: fn8(:) + fn8 = x + end function + subroutine sub8 (x, y) + integer, allocatable, intent(in) :: y(:) + integer, allocatable, intent(inout) :: x(:) + x = x + y + end subroutine +end module +subroutine test1 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test1 +subroutine test2 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test2 +subroutine test3 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test3 +subroutine test4 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test4 +subroutine test5 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & +!$omp & initializer (sub3 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn4 (omp_orig)) + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test5 +subroutine test6 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test6 +subroutine test7 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & +!$omp & initializer (sub3 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn4 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test7 +subroutine test8 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test8 +subroutine test9 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & +!$omp & initializer (sub5 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn6 (omp_orig)) + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test9 +subroutine test10 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test10 +subroutine test11 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & +!$omp & initializer (sub5 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn6 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test11 +subroutine test12 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test12 +subroutine test13 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" } +!$omp & fn5 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp initializer (omp_priv = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" } +!$omp & fn6 (omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } + integer :: a(9) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test13 +subroutine test14 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test14 +subroutine test15 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test15 +subroutine test16 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & +!$omp & initializer (sub7 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn8 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test16 +subroutine test17 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test17 diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/graphite/pr59817.f b/gcc-4.9/gcc/testsuite/gfortran.dg/graphite/pr59817.f new file mode 100644 index 000000000..a9ee8f19d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/graphite/pr59817.f @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-O2 -floop-interchange" } + SUBROUTINE PREPD(ICAST,ICAS,ICASX,ICAS1,ICAS2,NDET,NM,III,IMP, + * CASMIN) + LOGICAL CASMIN + DIMENSION ICAST(NDET,NM),IMP(NM) + IF(CASMIN) THEN + DO K=1,NDET + DO L=1,NM + IF(L.EQ.K-1) ICAST(K,L) = 1 + END DO + END DO + END IF + END SUBROUTINE diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/guality/guality.exp b/gcc-4.9/gcc/testsuite/gfortran.dg/guality/guality.exp index b3f64fbed..8f61ca360 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/guality/guality.exp +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/guality/guality.exp @@ -1,5 +1,8 @@ # This harness is for tests that should be run at all optimisation levels. +# Disable everywhere. These tests are very flaky. +return + load_lib gfortran-dg.exp load_lib gcc-gdb-test.exp diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/list_read_13.f b/gcc-4.9/gcc/testsuite/gfortran.dg/list_read_13.f new file mode 100644 index 000000000..0f8efd86c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/list_read_13.f @@ -0,0 +1,13 @@ +c { dg-do run } +c PR61049, reduced test case by Dominique d'Humieres + character(len=30) :: buff = ", (2.0, 3.0),,6.0D0, 2*," + DOUBLE PRECISION AVD, BVD, CVD, DVCORR + COMPLEX AVC, BVC, CVC, ZVCORR + + read(buff, *, err=10) AVD, AVC, BVC, BVD, CVC, CVD + goto 20 + 10 call abort + 20 continue + end + + diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/nint_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/nint_2.f90 index 9f2705318..0727136df 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/nint_2.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/nint_2.f90 @@ -4,7 +4,8 @@ ! http://gcc.gnu.org/ml/fortran/2005-04/msg00139.html ! ! { dg-do run } -! { dg-xfail-run-if "PR 33271, math library bug" { powerpc-ibm-aix* powerpc*-*-linux* *-*-mingw* } { "-O0" } { "" } } +! { dg-xfail-run-if "PR 33271, math library bug" { powerpc-ibm-aix* powerpc-*-linux* powerpc64-*-linux* *-*-mingw* } { "-O0" } { "" } } +! Note that this doesn't fail on powerpc64le-*-linux*. real(kind=8) :: a integer(kind=8) :: i1, i2 real :: b diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/oldstyle_5.f b/gcc-4.9/gcc/testsuite/gfortran.dg/oldstyle_5.f new file mode 100644 index 000000000..8a0d3119f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/oldstyle_5.f @@ -0,0 +1,8 @@ +C { dg-do compile } + TYPE T + INTEGER A(2)/1,2/ ! { dg-error "Invalid old style initialization for derived type component" } + END TYPE + TYPE S + INTEGER B/1/ ! { dg-error "Invalid old style initialization for derived type component" } + END TYPE + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/openmp-define-3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/openmp-define-3.f90 index 3d559864f..44d5c9de4 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/openmp-define-3.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/openmp-define-3.f90 @@ -6,6 +6,6 @@ # error _OPENMP not defined #endif -#if _OPENMP != 201107 +#if _OPENMP != 201307 # error _OPENMP defined to wrong value #endif diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/round_4.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/round_4.f90 index 975cb20e4..f60e1f785 100644 --- a/gcc-4.9/gcc/testsuite/gfortran.dg/round_4.f90 +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/round_4.f90 @@ -1,6 +1,7 @@ ! { dg-do run } ! { dg-add-options ieee } ! { dg-skip-if "PR libfortran/58015" { *-*-solaris2.9* hppa*-*-hpux* } } +! { dg-skip-if "IBM long double 31 bits of precision, test requires 38" { powerpc*-*-linux* } } ! ! PR fortran/35862 ! |