2015-12-02 Cesar Philippidis gcc/fortran/ PR fortran/63861 * openmp.c (gfc_match_omp_clauses): Allow subarrays for acc reductions. (resolve_omp_clauses): Error on any acc reductions on arrays. gcc/testsuite/ * gfortran.dg/goacc/array-reduction.f90: New test. * gfortran.dg/goacc/assumed.f95: Update expected diagnostics. * gfortran.dg/goacc/coarray.f95: Likewise. * gfortran.dg/goacc/coarray_2.f90: Likewise. * gfortran.dg/goacc/reduction-2.f95: Likewise. * gfortran.dg/goacc/reduction.f95: Likewise. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 6182464..276f2f1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -978,7 +978,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, if (gfc_match_omp_variable_list (" :", &c->lists[OMP_LIST_REDUCTION], - false, NULL, &head) == MATCH_YES) + false, NULL, &head, openacc) + == MATCH_YES) { gfc_omp_namelist *n; if (rop == OMP_REDUCTION_NONE) @@ -3313,6 +3314,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, &n->where); else n->sym->mark = 1; + + /* OpenACC does not support reductions on arrays. */ + if (n->sym->as) + gfc_error ("Array %qs is not permitted in reduction at %L", + n->sym->name, &n->where); } } diff --git a/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90 b/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90 new file mode 100644 index 0000000..d71c400 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90 @@ -0,0 +1,74 @@ +program test + implicit none + integer a(10), i + + a(:) = 0 + + ! Array reductions. + + !$acc parallel reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end parallel + + !$acc parallel + !$acc loop reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end parallel + + !$acc kernels + !$acc loop reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end kernels + + ! Subarray reductions. + + !$acc parallel reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end parallel + + !$acc parallel + !$acc loop reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end parallel + + !$acc kernels + !$acc loop reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a = a + 1 + end do + !$acc end kernels + + ! Reductions on array elements. + + !$acc parallel reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a(1) = a(1) + 1 + end do + !$acc end parallel + + !$acc parallel + !$acc loop reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a(1) = a(1) + 1 + end do + !$acc end parallel + + !$acc kernels + !$acc loop reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" } + do i = 1, 10 + a(1) = a(1) + 1 + end do + !$acc end kernels + + print *, a +end program test diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 index 3287241..4efe5a2 100644 --- a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 @@ -45,3 +45,6 @@ contains !$acc update self (a) ! { dg-error "Assumed rank" } end subroutine assumed_rank end module test + +! { dg-error "Array 'a' is not permitted in reduction" "" { target "*-*-*" } 18 } +! { dg-error "Array 'a' is not permitted in reduction" "" { target "*-*-*" } 39 } diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 b/gcc/testsuite/gfortran.dg/goacc/coarray.f95 index d2f10d5..932e1f7 100644 --- a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95 @@ -2,8 +2,6 @@ ! { dg-additional-options "-fcoarray=single" } ! ! PR fortran/63861 -! { dg-xfail-if "" { *-*-* } } -! { dg-excess-errors "TODO" } module test contains @@ -20,7 +18,7 @@ contains !$acc end parallel !$acc host_data use_device (a) !$acc end host_data - !$acc parallel loop reduction(+:a) + !$acc parallel loop reduction(+:a) ! { dg-error "Array 'a' is not permitted in reduction" } do i = 1,5 enddo !$acc end parallel loop diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 index 87e04d5..05167a1 100644 --- a/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 @@ -2,8 +2,6 @@ ! { dg-additional-options "-fcoarray=lib" } ! ! PR fortran/63861 -! { dg-xfail-if "" { *-*-* } } -! { dg-excess-errors "TODO" } module test contains @@ -20,7 +18,7 @@ contains !$acc end parallel !$acc host_data use_device (a) !$acc end host_data - !$acc parallel loop reduction(+:a) + !$acc parallel loop reduction(+:a) ! { dg-error "Array 'a' is not permitted in reduction" } do i = 1,5 enddo !$acc end parallel loop @@ -72,7 +70,7 @@ contains !$acc end parallel !$acc host_data use_device (a) !$acc end host_data - !$acc parallel loop reduction(+:a) + !$acc parallel loop reduction(+:a) ! { dg-error "Array 'a' is not permitted in reduction" } do i = 1,5 enddo !$acc end parallel loop @@ -94,7 +92,7 @@ contains !$acc end data !$acc parallel private (a) !$acc end parallel - !$acc parallel loop reduction(+:a) + !$acc parallel loop reduction(+:a) ! { dg-error "Array 'a' is not permitted in reduction" } do i = 1,5 enddo !$acc end parallel loop diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 index 89e63ae..929fb0e 100644 --- a/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 @@ -17,6 +17,6 @@ end subroutine ! { dg-final { scan-tree-dump-times "target oacc_parallel firstprivate.a." 1 "gimple" } } ! { dg-final { scan-tree-dump-times "acc loop private.p. reduction..:a." 1 "gimple" } } -! { dg-final { scan-tree-dump-times "target oacc_kernels map.tofrom:a .len: 4.." 1 "gimple" } } +! { dg-final { scan-tree-dump-times "target oacc_kernels map.force_tofrom:a .len: 4.." 1 "gimple" } } ! { dg-final { scan-tree-dump-times "acc loop private.k. reduction..:a." 1 "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95 index 833230a..a13574b 100644 --- a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95 @@ -136,3 +136,26 @@ common /blk/ i1 !$acc end parallel end subroutine + +! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } 27 } +! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } 29 } +! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } 31 } +! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } 33 } +! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } 35 } +! { dg-error "Array 'aa1' is not permitted in reduction" "" { target "*-*-*" } 65 } +! { dg-error "Array 'ia1' is not permitted in reduction" "" { target "*-*-*" } 67 } +! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } 71 } +! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } 77 } +! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } 81 } +! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } 85 } +! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } 89 } +! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } 93 } +! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } 99 } +! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } 103 } +! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } 107 } +! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } 113 } +! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } 117 } +! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } 121 } +! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } 125 } +! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } 129 } +! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } 135 }