diff options
author | Jakub Jelinek <jakub@redhat.com> | 2014-06-24 09:45:22 +0200 |
---|---|---|
committer | Jakub Jelinek <jakub@gcc.gnu.org> | 2014-06-24 09:45:22 +0200 |
commit | b46ebd6c7beaf55974973de0f02d39299b733bc9 (patch) | |
tree | 55405c922bb430cb45ea2427418eb2ed8cd74292 /libgomp/testsuite | |
parent | 335123531f234436288975eb80d3655756878d29 (diff) | |
download | gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.zip gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.tar.gz gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.tar.bz2 |
gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP, [...]): Make sure OMP_CLAUSE_SIZE is non-NULL.
* gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP,
OMP_CLAUSE_TO, OMP_CLAUSE_FROM): Make sure OMP_CLAUSE_SIZE is
non-NULL.
<case OMP_CLAUSE_ALIGNED>: Gimplify OMP_CLAUSE_ALIGNED_ALIGNMENT.
(gimplify_adjust_omp_clauses_1): Make sure OMP_CLAUSE_SIZE is
non-NULL.
(gimplify_adjust_omp_clauses): Likewise.
* omp-low.c (lower_rec_simd_input_clauses,
lower_rec_input_clauses, expand_omp_simd): Handle non-constant
safelen the same as safelen(1).
* tree-nested.c (convert_nonlocal_omp_clauses,
convert_local_omp_clauses): Handle OMP_CLAUSE_ALIGNED. For
OMP_CLAUSE_{MAP,TO,FROM} if not decl use walk_tree.
(convert_nonlocal_reference_stmt, convert_local_reference_stmt):
Fixup handling of GIMPLE_OMP_TARGET.
(convert_tramp_reference_stmt, convert_gimple_call): Handle
GIMPLE_OMP_TARGET.
gcc/fortran/
* dump-parse-tree.c (show_omp_namelist): Use n->udr->udr instead
of n->udr.
* f95-lang.c (gfc_init_builtin_functions): Initialize
BUILT_IN_ASSUME_ALIGNED.
* gfortran.h (gfc_omp_namelist): Change udr field type to
struct gfc_omp_namelist_udr.
(gfc_omp_namelist_udr): New type.
(gfc_get_omp_namelist_udr): Define.
(gfc_resolve_code): New prototype.
* match.c (gfc_free_omp_namelist): Free name->udr.
* module.c (intrinsics): Add INTRINSIC_USER.
(fix_mio_expr): Likewise.
(mio_expr): Handle INSTRINSIC_USER and non-resolved EXPR_FUNCTION.
* openmp.c (gfc_match_omp_clauses): Adjust initialization of n->udr.
(gfc_match_omp_declare_reduction): Treat len=: the same as len=*.
Set attr.flavor on omp_{out,in,priv,orig} artificial variables.
(struct resolve_omp_udr_callback_data): New type.
(resolve_omp_udr_callback, resolve_omp_udr_callback2,
resolve_omp_udr_clause): New functions.
(resolve_omp_clauses): Adjust for n->udr changes, resolve UDR clauses
here.
(omp_udr_callback): Don't check for implicitly declared functions
here.
(gfc_resolve_omp_udr): Don't call gfc_resolve. Don't check for
implicitly declared subroutines here.
* resolve.c (resolve_function): If value.function.isym is non-NULL,
consider it already resolved.
(resolve_code): Renamed to ...
(gfc_resolve_code): ... this. No longer static.
(gfc_resolve_blocks, generate_component_assignments, resolve_codes):
Adjust callers.
* trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
by reference type (C_PTR) variables.
(gfc_omp_finish_clause): Make sure OMP_CLAUSE_SIZE is non-NULL.
(gfc_trans_omp_udr_expr): Remove.
(gfc_trans_omp_array_reduction_or_udr): Adjust for n->udr changes.
Don't call gfc_trans_omp_udr_expr, even for sym->attr.dimension
expand it as assignment or subroutine call. Don't initialize
value.function.isym.
gcc/testsuite/
* gfortran.dg/gomp/udr2.f90 (f7, f9): Add !$omp parallel with
reduction clause.
* gfortran.dg/gomp/udr4.f90 (f4): Likewise.
Remove Label is never defined expected error.
* gfortran.dg/gomp/udr8.f90: New test.
libgomp/
* testsuite/libgomp.fortran/aligned1.f03: New test.
* testsuite/libgomp.fortran/nestedfn5.f90: New test.
* testsuite/libgomp.fortran/target7.f90: Surround loop spawning
tasks with !$omp parallel !$omp single.
* testsuite/libgomp.fortran/target8.f90: New test.
* testsuite/libgomp.fortran/udr4.f90 (foo UDR, bar UDR): Adjust
not to use trim in the combiner, instead call elemental function.
(fn): New elemental function.
* testsuite/libgomp.fortran/udr6.f90 (do_add, dp_add, dp_init):
Make elemental.
* testsuite/libgomp.fortran/udr7.f90 (omp_priv, omp_orig, omp_out,
omp_in): Likewise.
* testsuite/libgomp.fortran/udr12.f90: New test.
* testsuite/libgomp.fortran/udr13.f90: New test.
* testsuite/libgomp.fortran/udr14.f90: New test.
* testsuite/libgomp.fortran/udr15.f90: New test.
From-SVN: r211929
Diffstat (limited to 'libgomp/testsuite')
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/aligned1.f03 | 133 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/nestedfn5.f90 | 96 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/target7.f90 | 4 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/target8.f90 | 33 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr12.f90 | 76 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr13.f90 | 106 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr14.f90 | 50 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr15.f90 | 64 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr4.f90 | 15 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr6.f90 | 11 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/udr7.f90 | 24 |
11 files changed, 592 insertions, 20 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/aligned1.f03 b/libgomp/testsuite/libgomp.fortran/aligned1.f03 new file mode 100644 index 0000000..67a9ab4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/aligned1.f03 @@ -0,0 +1,133 @@ +! { dg-do run } +! { dg-options "-fopenmp -fcray-pointer" } + + use iso_c_binding, only : c_ptr, c_ptrdiff_t, c_loc + interface + subroutine foo (x, y, z, w) + use iso_c_binding, only : c_ptr + real, pointer :: x(:), y(:), w(:) + type(c_ptr) :: z + end subroutine + subroutine bar (x, y, z, w) + use iso_c_binding, only : c_ptr + real, pointer :: x(:), y(:), w(:) + type(c_ptr) :: z + end subroutine + subroutine baz (x, c) + real, pointer :: x(:) + real, allocatable :: c(:) + end subroutine + end interface + type dt + real, allocatable :: a(:) + end type + type (dt) :: b(64) + real, target :: a(4096+63) + real, pointer :: p(:), q(:), r(:), s(:) + real, allocatable :: c(:) + integer(c_ptrdiff_t) :: o + integer :: i + o = 64 - mod (loc (a), 64) + if (o == 64) o = 0 + o = o / sizeof(0.0) + p => a(o + 1:o + 1024) + q => a(o + 1025:o + 2048) + r => a(o + 2049:o + 3072) + s => a(o + 3073:o + 4096) + do i = 1, 1024 + p(i) = i + q(i) = i + r(i) = i + s(i) = i + end do + call foo (p, q, c_loc (r(1)), s) + do i = 1, 1024 + if (p(i) /= i * i + 3 * i + 2) call abort + p(i) = i + end do + call bar (p, q, c_loc (r(1)), s) + do i = 1, 1024 + if (p(i) /= i * i + 3 * i + 2) call abort + end do + ! Attempt to create 64-byte aligned allocatable + do i = 1, 64 + allocate (c(1023 + i)) + if (iand (loc (c(1)), 63) == 0) exit + deallocate (c) + allocate (b(i)%a(1023 + i)) + allocate (c(1023 + i)) + if (iand (loc (c(1)), 63) == 0) exit + deallocate (c) + end do + if (allocated (c)) then + do i = 1, 1024 + c(i) = 2 * i + end do + call baz (p, c) + do i = 1, 1024 + if (p(i) /= i * i + 5 * i + 2) call abort + end do + end if +end +subroutine foo (x, y, z, w) + use iso_c_binding, only : c_ptr, c_f_pointer + real, pointer :: x(:), y(:), w(:), p(:) + type(c_ptr) :: z + integer :: i + real :: pt(1024) + pointer (ip, pt) + ip = loc (w) +!$omp simd aligned (x, y : 64) + do i = 1, 1024 + x(i) = x(i) * y(i) + 2.0 + end do +!$omp simd aligned (x, z : 64) private (p) + do i = 1, 1024 + call c_f_pointer (z, p, shape=[1024]) + x(i) = x(i) + p(i) + end do +!$omp simd aligned (x, ip : 64) + do i = 1, 1024 + x(i) = x(i) + 2 * pt(i) + end do +!$omp end simd +end subroutine +subroutine bar (x, y, z, w) + use iso_c_binding, only : c_ptr, c_f_pointer + real, pointer :: x(:), y(:), w(:), a(:), b(:) + type(c_ptr) :: z, c + integer :: i + real :: pt(1024) + pointer (ip, pt) + ip = loc (w) + a => x + b => y + c = z +!$omp simd aligned (a, b : 64) + do i = 1, 1024 + a(i) = a(i) * b(i) + 2.0 + end do +!$omp simd aligned (a, c : 64) + do i = 1, 1024 + block + real, pointer :: p(:) + call c_f_pointer (c, p, shape=[1024]) + a(i) = a(i) + p(i) + end block + end do +!$omp simd aligned (a, ip : 64) + do i = 1, 1024 + a(i) = a(i) + 2 * pt(i) + end do +!$omp end simd +end subroutine +subroutine baz (x, c) + real, pointer :: x(:) + real, allocatable :: c(:) + integer :: i +!$omp simd aligned (x, c : 64) + do i = 1, 1024 + x(i) = x(i) + c(i) + end do +!$omp end simd +end subroutine baz diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 new file mode 100644 index 0000000..f67bd47 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 @@ -0,0 +1,96 @@ +! { dg-do run } + + interface + subroutine bar (q) + integer :: q(19:) + end subroutine + end interface + integer :: q(7:15) + q(:) = 5 + call bar (q) +end +subroutine bar (q) + use iso_c_binding, only: c_ptr, c_loc, c_int + integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p + integer(c_int), target :: e(64) + type (c_ptr) :: f, g(64) + logical :: l + a = 1 + b = 2 + c = 3 + d = 4 + l = .false. + f = c_loc (e) + call foo +contains + subroutine foo + use iso_c_binding, only: c_sizeof +!$omp simd linear(a:2) linear(b:1) + do a = 1, 20, 2 + b = b + 1 + end do +!$omp end simd + if (a /= 21 .or. b /= 12) call abort +!$omp simd aligned(f : c_sizeof (e(1))) + do b = 1, 64 + g(b) = f + end do +!$omp end simd +!$omp parallel +!$omp single +!$omp taskgroup +!$omp task depend(out : a, d(2:2,4:5)) + a = a + 1 + d(2:2,4:5) = d(2:2,4:5) + 1 +!$omp end task +!$omp task depend(in : a, d(2:2,4:5)) + if (a /= 22) call abort + if (any (d(2:2,4:5) /= 5)) call abort +!$omp end task +!$omp end taskgroup +!$omp end single +!$omp end parallel + b = 10 +!$omp target data map (tofrom: a, d(2:3,4:4), q) map (from: l) +!$omp target map (tofrom: b, d(2:3,4:4)) + l = .false. + if (a /= 22 .or. any (q /= 5)) l = .true. + if (lbound (q, 1) /= 19 .or. ubound (q, 1) /= 27) l = .true. + if (d(2,4) /= 5 .or. d(3,4) /= 4) l = .true. + l = l .or. (b /= 10) + a = 6 + b = 11 + q = 8 + d(2:3,4:4) = 9 +!$omp end target +!$omp target update from (a, q, d(2:3,4:4), l) + if (a /= 6 .or. l .or. b /= 11 .or. any (q /= 8)) call abort + if (any (d(2:3,4:4) /= 9) .or. d(2,5) /= 5 .or. d(3,5) /= 4) call abort + a = 12 + b = 13 + q = 14 + d = 15 +!$omp target update to (a, q, d(2:3,4:4)) +!$omp target map (tofrom: b, d(2:3,4:4)) + if (a /= 12 .or. b /= 13 .or. any (q /= 14)) l = .true. + l = l .or. any (d(2:3,4:4) /= 15) +!$omp end target + a = 0 + b = 1 + c = 100 + h = 8 + m = 0 + n = 64 + o = 16 + if (l) call abort +!$omp target teams distribute parallel do simd if (.not.l) device(a) & +!$omp & num_teams(b) dist_schedule(static, c) num_threads (h) & +!$omp & reduction (+: m) safelen (n) schedule(static, o) + do p = 1, 64 + m = m + 1 + end do +!$omp end target teams distribute parallel do simd + if (m /= 64) call abort +!$omp end target data + end subroutine foo +end subroutine bar diff --git a/libgomp/testsuite/libgomp.fortran/target7.f90 b/libgomp/testsuite/libgomp.fortran/target7.f90 index 4af0ee3..0c977c4 100644 --- a/libgomp/testsuite/libgomp.fortran/target7.f90 +++ b/libgomp/testsuite/libgomp.fortran/target7.f90 @@ -13,6 +13,8 @@ do i = 1, n a(i) = i end do + !$omp parallel + !$omp single do i = 1, n, c !$omp task shared(a) !$omp target map(a(i:i+c-1)) @@ -23,6 +25,8 @@ !$omp end target !$omp end task end do + !$omp end single + !$omp end parallel do i = 1, n if (a(i) /= i + 1) call abort end do diff --git a/libgomp/testsuite/libgomp.fortran/target8.f90 b/libgomp/testsuite/libgomp.fortran/target8.f90 new file mode 100644 index 0000000..0564e90 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target8.f90 @@ -0,0 +1,33 @@ +! { dg-do run } + + integer, parameter :: n = 1000 + integer, parameter :: c = 100 + integer :: i, j + real :: a(n) + do i = 1, n + a(i) = i + end do + !$omp parallel + !$omp single + do i = 1, n, c + !$omp task shared(a) + !$omp target map(a(i:i+c-1)) + !$omp parallel do + do j = i, i + c - 1 + a(j) = foo (a(j)) + end do + !$omp end target + !$omp end task + end do + !$omp end single + !$omp end parallel + do i = 1, n + if (a(i) /= i + 1) call abort + end do +contains + real function foo (x) + !$omp declare target + real, intent(in) :: x + foo = x + 1 + end function foo +end diff --git a/libgomp/testsuite/libgomp.fortran/udr12.f90 b/libgomp/testsuite/libgomp.fortran/udr12.f90 new file mode 100644 index 0000000..601bca6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr12.f90 @@ -0,0 +1,76 @@ +! { dg-do run } + + interface + elemental subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + end subroutine + elemental function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + end function + end interface +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + interface + elemental function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + end function + elemental subroutine sub2 (x, y) + integer, intent(in) :: y + integer, intent(inout) :: x + end subroutine + end interface + integer :: a(10), b, r + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (foo : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 2 * r) .or. b /= 3 * r) call abort + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (bar : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 4 * r) .or. b /= 6 * r) call abort + a(:) = 0 + b = 0 + r = 0 +!$omp parallel reduction (baz : a, b) reduction (+: r) + a = a + 2 + b = b + 3 + r = r + 1 +!$omp end parallel + if (any (a /= 2 * r) .or. b /= 3 * r) call abort +end +elemental function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + fn1 = x + 2 * y +end function +elemental subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + x = 0 +end subroutine +elemental function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + fn2 = x +end function +elemental subroutine sub2 (x, y) + integer, intent(inout) :: x + integer, intent(in) :: y + x = x + y +end subroutine diff --git a/libgomp/testsuite/libgomp.fortran/udr13.f90 b/libgomp/testsuite/libgomp.fortran/udr13.f90 new file mode 100644 index 0000000..0da1da4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr13.f90 @@ -0,0 +1,106 @@ +! { dg-do run } + + interface + subroutine sub1 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + end subroutine + function fn2 (x, m1, m2, n1, n2) + integer, intent(in) :: x(:,:), m1, m2, n1, n2 + integer :: fn2(m1:m2,n1:n2) + end function + subroutine sub3 (x, y) + integer, allocatable, intent(in) :: y(:,:) + integer, allocatable, intent(inout) :: x(:,:) + end subroutine + end interface +!$omp declare reduction (foo : integer : sub3 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn3 (omp_orig)) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in, & +!$omp & lbound (omp_out, 1), ubound (omp_out, 1))) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig, lbound (omp_priv, 1), & +!$omp ubound (omp_priv, 1), lbound (omp_priv, 2), ubound (omp_priv, 2))) + interface + function fn1 (x, y, m1, m2) + integer, intent(in) :: x(:), y(:), m1, m2 + integer :: fn1(m1:m2) + end function + subroutine sub2 (x, y) + integer, intent(in) :: y(:,:) + integer, intent(inout) :: x(:,:) + end subroutine + function fn3 (x) + integer, allocatable, intent(in) :: x(:,:) + integer, allocatable :: fn3(:,:) + end function + end interface + integer :: a(10), b(3:5,7:9), r + integer, allocatable :: c(:,:) + a(:) = 0 + r = 0 +!$omp parallel reduction (bar : a) reduction (+: r) + if (lbound (a, 1) /= 1 .or. ubound (a, 1) /= 10) call abort + a = a + 2 + r = r + 1 +!$omp end parallel + if (any (a /= 4 * r) ) call abort + b(:,:) = 0 + allocate (c (4:6,8:10)) + c(:,:) = 0 + r = 0 +!$omp parallel reduction (baz : b, c) reduction (+: r) + if (lbound (b, 1) /= 3 .or. ubound (b, 1) /= 5) call abort + if (lbound (b, 2) /= 7 .or. ubound (b, 2) /= 9) call abort + if (.not. allocated (c)) call abort + if (lbound (c, 1) /= 4 .or. ubound (c, 1) /= 6) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 10) call abort + b = b + 3 + c = c + 4 + r = r + 1 +!$omp end parallel + if (any (b /= 3 * r) .or. any (c /= 4 * r)) call abort + deallocate (c) + allocate (c (0:1,7:11)) + c(:,:) = 0 + r = 0 +!$omp parallel reduction (foo : c) reduction (+: r) + if (.not. allocated (c)) call abort + if (lbound (c, 1) /= 0 .or. ubound (c, 1) /= 1) call abort + if (lbound (c, 2) /= 7 .or. ubound (c, 2) /= 11) call abort + c = c + 5 + r = r + 1 +!$omp end parallel + if (any (c /= 10 * r)) call abort +end +function fn1 (x, y, m1, m2) + integer, intent(in) :: x(:), y(:), m1, m2 + integer :: fn1(m1:m2) + fn1 = x + 2 * y +end function +subroutine sub1 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + x = 0 +end subroutine +function fn2 (x, m1, m2, n1, n2) + integer, intent(in) :: x(:,:), m1, m2, n1, n2 + integer :: fn2(m1:m2,n1:n2) + fn2 = x +end function +subroutine sub2 (x, y) + integer, intent(inout) :: x(:,:) + integer, intent(in) :: y(:,:) + x = x + y +end subroutine +function fn3 (x) + integer, allocatable, intent(in) :: x(:,:) + integer, allocatable :: fn3(:,:) + fn3 = x +end function +subroutine sub3 (x, y) + integer, allocatable, intent(inout) :: x(:,:) + integer, allocatable, intent(in) :: y(:,:) + x = x + 2 * y +end subroutine diff --git a/libgomp/testsuite/libgomp.fortran/udr14.f90 b/libgomp/testsuite/libgomp.fortran/udr14.f90 new file mode 100644 index 0000000..d697458 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr14.f90 @@ -0,0 +1,50 @@ +! { dg-do run } + + type dt + integer :: g + integer, allocatable :: h(:) + end type +!$omp declare reduction (baz : dt : bar (omp_out, omp_in)) & +!$omp & initializer (foo (omp_priv, omp_orig)) + integer :: r + type (dt), allocatable :: a(:) + allocate (a(7:8)) + a(:)%g = 0 + a(7)%h = (/ 0, 0, 0 /) + r = 0 +!$omp parallel reduction(+:r) reduction (baz:a) + if (.not.allocated (a)) call abort + if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) call abort + if (.not.allocated (a(7)%h)) call abort + if (allocated (a(8)%h)) call abort + if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) call abort + a(:)%g = a(:)%g + 2 + a(7)%h = a(7)%h + 3 + r = r + 1 +!$omp end parallel + if (.not.allocated (a)) call abort + if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) call abort + if (.not.allocated (a(7)%h)) call abort + if (allocated (a(8)%h)) call abort + if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) call abort + if (any (a(:)%g /= 2 * r) .or. any (a(7)%h(:) /= 3 * r)) call abort +contains + subroutine foo (x, y) + type (dt), allocatable :: x(:), y(:) + if (allocated (x) .neqv. allocated (y)) call abort + if (lbound (x, 1) /= lbound (y, 1)) call abort + if (ubound (x, 1) /= ubound (y, 1)) call abort + if (allocated (x(7)%h) .neqv. allocated (y(7)%h)) call abort + if (allocated (x(8)%h) .neqv. allocated (y(8)%h)) call abort + if (lbound (x(7)%h, 1) /= lbound (y(7)%h, 1)) call abort + if (ubound (x(7)%h, 1) /= ubound (y(7)%h, 1)) call abort + x(7)%g = 0 + x(7)%h = 0 + x(8)%g = 0 + end subroutine + subroutine bar (x, y) + type (dt), allocatable :: x(:), y(:) + x(:)%g = x(:)%g + y(:)%g + x(7)%h(:) = x(7)%h(:) + y(7)%h(:) + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/udr15.f90 b/libgomp/testsuite/libgomp.fortran/udr15.f90 new file mode 100644 index 0000000..2d11695 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/udr15.f90 @@ -0,0 +1,64 @@ +! { dg-do run } + +module udr15m1 + integer, parameter :: a = 6 + integer :: b +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) +!$omp declare reduction (.add. : integer : & +!$omp & omp_out = omp_out .add. f3 (omp_in, -4)) & +!$omp & initializer (s1 (omp_priv, omp_orig)) + interface operator (.add.) + module procedure f1 + end interface +contains + integer function f1 (x, y) + integer, intent (in) :: x, y + f1 = x + y + end function f1 + integer function f3 (x, y) + integer, intent (in) :: x, y + f3 = iand (x, y) + end function f3 + subroutine s1 (x, y) + integer, intent (in) :: y + integer, intent (out) :: x + x = 3 + end subroutine s1 +end module udr15m1 +module udr15m2 + use udr15m1, f4 => f1, f5 => f3, s2 => s1, operator (.addtwo.) => operator (.add.) + type dt + integer :: x + end type +!$omp declare reduction (+ : dt : omp_out = f6 (omp_out + omp_in)) & +!$omp & initializer (s3 (omp_priv)) + interface operator (+) + module procedure f2 + end interface +contains + type(dt) function f2 (x, y) + type(dt), intent (in) :: x, y + f2%x = x%x + y%x + end function f2 + type(dt) function f6 (x) + type(dt), intent (in) :: x + f6%x = x%x + end function f6 + subroutine s3 (x) + type(dt), intent (out) :: x + x = dt(0) + end subroutine +end module udr15m2 + use udr15m2, operator (.addthree.) => operator (.addtwo.), & + f7 => f4, f8 => f6, s4 => s3 + integer :: i, j + type(dt) :: d + j = 3 + d%x = 0 +!$omp parallel do reduction (.addthree.: j) reduction (+ : d) + do i = 1, 100 + j = j.addthree.iand (i, -4) + d = d + dt(i) + end do + if (d%x /= 5050 .or. j /= 4903) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/udr4.f90 b/libgomp/testsuite/libgomp.fortran/udr4.f90 index 50f6900..8936547 100644 --- a/libgomp/testsuite/libgomp.fortran/udr4.f90 +++ b/libgomp/testsuite/libgomp.fortran/udr4.f90 @@ -1,9 +1,9 @@ ! { dg-do run } !$omp declare reduction (foo : character(kind=1, len=*) & -!$omp & : omp_out = trim(omp_out) // omp_in) initializer (omp_priv = '') +!$omp & : omp_out = fn (omp_out, omp_in)) initializer (omp_priv = '') !$omp declare reduction (bar : character(kind=1, len=:) & -!$omp & : omp_out = trim(omp_in) // omp_out) initializer (omp_priv = '') +!$omp & : omp_out = fn (omp_in, omp_out)) initializer (omp_priv = '') !$omp declare reduction (baz : character(kind=1, len=1) & !$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) & !$omp & - ichar ('0'))) initializer (omp_priv = '0') @@ -11,6 +11,12 @@ !$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) & !$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + & !$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00') + interface + elemental function fn (x, y) + character (len=64), intent (in) :: x, y + character (len=64) :: fn + end function + end interface character(kind=1, len=64) :: c(-3:-2,1:1,7:8), d(2:3,-7:-5) character(kind = 1, len=1) :: e(2:4) character(kind = 1, len=1+1) :: f(8:10,9:10) @@ -37,3 +43,8 @@ if (any (f(:,:)(1:1).ne.char (ichar ('0') + 32))) call abort if (any (f(:,:)(2:2).ne.char (ichar ('0') + 64))) call abort end +elemental function fn (x, y) + character (len=64), intent (in) :: x, y + character (len=64) :: fn + fn = trim(x) // y +end function diff --git a/libgomp/testsuite/libgomp.fortran/udr6.f90 b/libgomp/testsuite/libgomp.fortran/udr6.f90 index 7fb3ee5..20736fb 100644 --- a/libgomp/testsuite/libgomp.fortran/udr6.f90 +++ b/libgomp/testsuite/libgomp.fortran/udr6.f90 @@ -8,17 +8,18 @@ module m real :: r = 0.0 end type contains - function do_add(x, y) + elemental function do_add(x, y) type (dt), intent (in) :: x, y type (dt) :: do_add do_add%r = x%r + y%r end function - subroutine dp_add(x, y) - double precision :: x, y + elemental subroutine dp_add(x, y) + double precision, intent (inout) :: x + double precision, intent (in) :: y x = x + y end subroutine - subroutine dp_init(x) - double precision :: x + elemental subroutine dp_init(x) + double precision, intent (out) :: x x = 0.0 end subroutine end module diff --git a/libgomp/testsuite/libgomp.fortran/udr7.f90 b/libgomp/testsuite/libgomp.fortran/udr7.f90 index 5253dd7..42be00c 100644 --- a/libgomp/testsuite/libgomp.fortran/udr7.f90 +++ b/libgomp/testsuite/libgomp.fortran/udr7.f90 @@ -3,17 +3,17 @@ program udr7 implicit none interface - subroutine omp_priv (x, y, z) + elemental subroutine omp_priv (x, y, z) real, intent (in) :: x real, intent (inout) :: y - real, intent (in) :: z(:) + real, intent (in) :: z end subroutine omp_priv - real function omp_orig (x) + elemental real function omp_orig (x) real, intent (in) :: x end function omp_orig end interface !$omp declare reduction (omp_priv : real : & -!$omp & omp_priv (omp_orig (omp_in), omp_out, (/ 1.0, 2.0, 3.0 /))) & +!$omp & omp_priv (omp_orig (omp_in), omp_out, 1.0)) & !$omp & initializer (omp_out (omp_priv, omp_in (omp_orig))) real :: x (2:4, 1:1, -2:0) integer :: i @@ -24,25 +24,23 @@ program udr7 end do if (any (x /= 2080.0)) call abort contains - subroutine omp_out (x, y) + elemental subroutine omp_out (x, y) real, intent (out) :: x real, intent (in) :: y - if (y /= 4.0) call abort - x = 0.0 + x = y - 4.0 end subroutine omp_out - real function omp_in (x) + elemental real function omp_in (x) real, intent (in) :: x omp_in = x + 4.0 end function omp_in end program udr7 -subroutine omp_priv (x, y, z) +elemental subroutine omp_priv (x, y, z) real, intent (in) :: x real, intent (inout) :: y - real, intent (in) :: z(:) - if (any (z .ne. (/ 1.0, 2.0, 3.0 /))) call abort - y = y + (x - 4.0) + real, intent (in) :: z + y = y + (x - 4.0) + (z - 1.0) end subroutine omp_priv -real function omp_orig (x) +elemental real function omp_orig (x) real, intent (in) :: x omp_orig = x + 4.0 end function omp_orig |