Re: [OpenACC 0/7] host_data construct

[Cesar Philippidis <cesar@codesourcery.com>]

[-- Attachment #1: Type: text/plain, Size: 2194 bytes --]

On 12/02/2015 07:58 AM, Thomas Schwinge wrote:

> diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
> index 130ffc3..d2f10d5 100644
> --- gcc/testsuite/gfortran.dg/goacc/coarray.f95
> +++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
> @@ -1,7 +1,9 @@
>  ! { dg-do compile } 
>  ! { dg-additional-options "-fcoarray=single" }
> -
> -! TODO: These cases must fail
> +!
> +! PR fortran/63861
> +! { dg-xfail-if "<http://gcc.gnu.org/PR63861>" { *-*-* } }
> +! { dg-excess-errors "TODO" }
>  
>  module test
>  contains
> @@ -9,7 +11,6 @@ contains
>      implicit none
>      integer :: i
>      integer, codimension[*] :: a
> -    ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
>      !$acc declare device_resident (a)
>      !$acc data copy (a)
>      !$acc end data
> @@ -17,7 +18,6 @@ contains
>      !$acc end data
>      !$acc parallel private (a)
>      !$acc end parallel
> -    ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
>      !$acc host_data use_device (a)
>      !$acc end host_data
>      !$acc parallel loop reduction(+:a)
> diff --git gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
> index f9cf9ac..87e04d5 100644
> --- gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
> +++ gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
> @@ -3,6 +3,7 @@
>  !
>  ! PR fortran/63861
>  ! { dg-xfail-if "<http://gcc.gnu.org/PR63861>" { *-*-* } }
> +! { dg-excess-errors "TODO" }

This host_data patch exposed a bug in the fortran front end where it was
allowing arrays to be used as reduction variables. If replace you
replace codimension with dimension, you'd see a similar ICE. The
attached patch, while it doesn't make any attempt to fix the gimplifier
changes, does teach the fortran front end to error on acc reductions
containing array variables.

Note that this solution is somewhat aggressive because we probably
should allow reductions on individual array elements. E.g.

  !$acc loop reduction(+:var(1))

The c and c++ front ends also have that problem. Maybe I'll revisit this
later.

Is this ok for trunk? It will close pr63861.

Cesar

[-- Attachment #2: gfc_array-reductions.diff --]
[-- Type: text/x-patch, Size: 8939 bytes --]

2015-12-02  Cesar Philippidis  <cesar@codesourcery.com>

	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 "<http://gcc.gnu.org/PR63861>" { *-*-* } }
-! { 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 "<http://gcc.gnu.org/PR63861>" { *-*-* } }
-! { 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 }