[4/5] OpenACC tile clause support, Fortran front-end parts

2016-11-29  Cesar Philippidis  <cesar@codesourcery.com>
	    Joseph Myers  <joseph@codesourcery.com>

	gcc/fortran/
	* gfortranspec.c (lang_specific_pre_link): Update call to do_spec.
	* openmp.c (resolve_omp_clauses): Error on directives
	containing both tile and collapse clauses.
	(resolve_oacc_loop_blocks): Represent '*' tile arguments as zero.
	* trans-openmp.c (gfc_trans_omp_do): Lower tiled loops like
 	collapsed loops.

	gcc/testsuite/
	* gfortran.dg/goacc/combined-directives.f90: Remove xfail.
	* gfortran.dg/goacc/tile-1.f90: New test.
	* gfortran.dg/goacc/tile-2.f90: New test.
	* gfortran.dg/goacc/tile-lowering.f95: New test.


diff --git a/gcc/fortran/gfortranspec.c b/gcc/fortran/gfortranspec.c
index 8a0e19a..6dc6fbe 100644
--- a/gcc/fortran/gfortranspec.c
+++ b/gcc/fortran/gfortranspec.c
@@ -439,7 +439,7 @@  int
 lang_specific_pre_link (void)
 {
   if (library)
-    do_spec ("%:include(libgfortran.spec)");
+    do_spec ("%:include(libgfortran.spec)", 0);
 
   return 0;
 }
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 11ffb5d..81f758e 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -4757,6 +4757,8 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
     if (omp_clauses->wait_list)
       for (el = omp_clauses->wait_list; el; el = el->next)
 	resolve_scalar_int_expr (el->expr, "WAIT");
+  if (omp_clauses->collapse && omp_clauses->tile_list)
+    gfc_error ("Incompatible use of TILE and COLLAPSE at %L", &code->loc);
   if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
     gfc_error ("SOURCE dependence type only allowed "
 	       "on ORDERED directive at %L", &code->loc);
@@ -5903,11 +5905,11 @@  resolve_oacc_loop_blocks (gfc_code *code)
 	  if (el->expr == NULL)
 	    {
 	      /* NULL expressions are used to represent '*' arguments.
-		 Convert those to a -1 expressions.  */
+		 Convert those to a 0 expressions.  */
 	      el->expr = gfc_get_constant_expr (BT_INTEGER,
 						gfc_default_integer_kind,
 						&code->loc);
-	      mpz_set_si (el->expr->value.integer, -1);
+	      mpz_set_si (el->expr->value.integer, 0);
 	    }
 	  else
 	    {
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 59fd6b3..d38bebc 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3455,6 +3455,17 @@  gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
   dovar_init *di;
   unsigned ix;
   vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
+  gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list;
+
+  /* Both collapsed and tiled loops are lowered the same way.  In
+     OpenACC, those clauses are not compatible, so prioritize the tile
+     clause, if present.  */
+  if (tile)
+    {
+      collapse = 0;
+      for (gfc_expr_list *el = tile; el; el = el->next)
+	collapse++;
+    }
 
   doacross_steps = NULL;
   if (clauses->orderedc)
diff --git a/gcc/testsuite/gfortran.dg/goacc/combined-directives.f90 b/gcc/testsuite/gfortran.dg/goacc/combined-directives.f90
index abb5e6b..42a447a 100644
--- a/gcc/testsuite/gfortran.dg/goacc/combined-directives.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/combined-directives.f90
@@ -143,8 +143,7 @@  end subroutine test
 ! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. vector" 2 "gimple" } }
 ! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. seq" 2 "gimple" } }
 ! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. auto" 2 "gimple" } }
-! XFAILed: OpenACC tile clauses are discarded during gimplification.
-! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. tile.2, 3" 2 "gimple" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. tile.2, 3" 2 "gimple" } }
 ! { dg-final { scan-tree-dump-times "acc loop private.i. independent" 2 "gimple" } }
 ! { dg-final { scan-tree-dump-times "private.z" 2 "gimple" } }
 ! { dg-final { scan-tree-dump-times "omp target oacc_\[^ \]+ map.force_tofrom:y" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
new file mode 100644
index 0000000..3dbabda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
@@ -0,0 +1,339 @@ 
+subroutine parloop
+  integer, parameter :: n = 100
+  integer i, j, k, a
+
+  !$acc parallel loop tile(10)
+  do i = 1, n
+  end do
+  
+  !$acc parallel loop tile(*)
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(10, *)
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+ 
+  !$acc parallel loop tile(10, *, i) ! { dg-error "" }
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc parallel loop tile ! { dg-error "Unclassifiable" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile() ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(,1) ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(,,) ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(1.1) ! { dg-error "requires a scalar INTEGER" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(-3) ! { dg-warning "must be positive" }
+  do i = 1, n
+  end do
+
+  !$acc parallel loop tile(10, -3) ! { dg-warning "must be positive" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc parallel loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc parallel loop tile(10, .true.) ! { dg-error "requires a scalar" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc parallel loop tile(1, a) ! { dg-error "constant expression" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc parallel loop tile(a, 1) ! { dg-error "constant expression" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc parallel loop tile(2, 3) collapse (2) ! { dg-error "Incompatible use" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+end subroutine parloop
+
+subroutine par
+  integer, parameter :: n = 100
+  integer i, j, k
+
+  !$acc parallel
+  !$acc loop tile ! { dg-error "Unclassifiable" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile() ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(1)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2)
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc loop tile(-2) ! { dg-warning "must be positive" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(i) ! { dg-error "constant expression" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2, 2, 1)
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc parallel loop tile(2, 2)
+  do i = 1, n
+     do j = i+1, n, j ! { dg-error "rectangular iteration space" }
+     end do
+  end do
+
+  !$acc loop vector tile(*)
+  do i = 1, n
+  end do
+  
+  !$acc loop worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop gang tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop vector gang tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop vector worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop gang worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2, 3) collapse (2) ! { dg-error "Incompatible use" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+  !$acc end parallel
+end subroutine par
+
+subroutine kern
+  integer, parameter :: n = 100
+  integer i, j, k
+
+  !$acc kernels
+  !$acc loop tile  ! { dg-error "Unclassifiable" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile() ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(1)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2)
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc loop tile(-2) ! { dg-warning "must be positive" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(i) ! { dg-error "constant expression" }
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2, 2, 1)
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc parallel loop tile(2, 2)
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc loop vector tile(*)
+  do i = 1, n
+  end do
+  
+  !$acc loop worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop gang tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop vector gang tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop vector worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop gang worker tile(*)
+  do i = 1, n
+  end do
+
+  !$acc loop tile(2, 3) collapse (2) ! { dg-error "Incompatible use" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+  !$acc end kernels
+end subroutine kern
+
+subroutine kernsloop
+  integer, parameter :: n = 100
+  integer i, j, k, a
+
+  !$acc kernels loop tile(10)
+  do i = 1, n
+  end do
+  
+  !$acc kernels loop tile(*)
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(10, *)
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+ 
+  !$acc kernels loop tile(10, *, i) ! { dg-error "" }
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc kernels loop tile ! { dg-error "Unclassifiable" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile() ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(,1) ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(,,) ! { dg-error "Syntax error" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(1.1) ! { dg-error "requires a scalar INTEGER" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(-3) ! { dg-warning "must be positive" }
+  do i = 1, n
+  end do
+
+  !$acc kernels loop tile(10, -3) ! { dg-warning "must be positive" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc kernels loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+  do i = 1, n
+     do j = 1, n
+        do k = 1, n
+        end do
+     end do
+  end do 
+
+  !$acc kernels loop tile(10, .true.) ! { dg-error "requires a scalar" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc kernels loop tile(1, a) ! { dg-error "constant expression" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc kernels loop tile(a, 1) ! { dg-error "constant expression" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+
+  !$acc kernels loop tile(2, 3) collapse (2) ! { dg-error "Incompatible use" }
+  do i = 1, n
+     do j = 1, n
+     end do
+  end do
+end subroutine kernsloop
diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-2.f90 b/gcc/testsuite/gfortran.dg/goacc/tile-2.f90
new file mode 100644
index 0000000..c567543
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/tile-2.f90
@@ -0,0 +1,21 @@ 
+subroutine par
+  integer ix, jx
+
+  !$acc parallel
+  !$acc loop tile (*,*) ! { dg-error "not enough DO loops for tiled" }
+  do ix = 1, 30
+  end do
+
+  !$acc loop tile (*,*)
+  do ix = 1, 30
+     do jx = 1, ix ! { dg-error "tiled loops don.t form rectangular" }
+     end do
+  end do
+
+  !$acc loop tile (*)
+  do ix = 1, 30
+     do jx = 1, ix
+     end do
+  end do
+  !$acc end parallel
+end subroutine par
diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-lowering.f95 b/gcc/testsuite/gfortran.dg/goacc/tile-lowering.f95
new file mode 100644
index 0000000..1cb8b9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/tile-lowering.f95
@@ -0,0 +1,292 @@ 
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine par
+  integer i, j, k
+
+  !$acc parallel
+  !$acc loop tile (1)
+  do i = 1, 10
+  end do
+
+  !$acc loop tile (*)
+  do i = 1, 10
+  end do
+
+  !$acc loop tile (1,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (*,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (1,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (*,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (1,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (*,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (1,*,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (1,2,*)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+  !$acc end parallel
+end subroutine par
+
+subroutine kerns
+  integer i, j, k
+
+  !$acc kernels
+  !$acc loop tile (1)
+  do i = 1, 10
+  end do
+
+  !$acc loop tile (*)
+  do i = 1, 10
+  end do
+
+  !$acc loop tile (1,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (*,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (1,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (*,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc loop tile (1,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (*,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (1,*,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc loop tile (1,2,*)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+  !$acc end kernels
+end subroutine kerns
+
+subroutine parloop
+  integer i, j, k
+
+  !$acc parallel loop tile (1)
+  do i = 1, 10
+  end do
+
+  !$acc parallel loop tile (*)
+  do i = 1, 10
+  end do
+
+  !$acc parallel loop tile (1,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc parallel loop tile (*,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc parallel loop tile (1,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc parallel loop tile (*,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc parallel loop tile (1,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc parallel loop tile (*,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc parallel loop tile (1,*,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc parallel loop tile (1,2,*)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+end subroutine parloop
+
+subroutine kernloop
+  integer i, j, k
+
+  !$acc kernels loop tile (1)
+  do i = 1, 10
+  end do
+
+  !$acc kernels loop tile (*)
+  do i = 1, 10
+  end do
+
+  !$acc kernels loop tile (1,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc kernels loop tile (*,2)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc kernels loop tile (1,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc kernels loop tile (*,*)
+  do i = 1, 10
+     do j = 1, 10
+     end do
+  end do
+
+  !$acc kernels loop tile (1,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc kernels loop tile (*,2,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc kernels loop tile (1,*,3)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+
+  !$acc kernels loop tile (1,2,*)
+  do i = 1, 10
+     do j = 1, 10
+        do k = 1, 10
+        end do
+     end do
+  end do
+end subroutine kernloop
+
+
+! { dg-final { scan-tree-dump-times "tile\\(1\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(0\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(1, 2\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(0, 2\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(1, 0\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(0, 0\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(1, 2, 3\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(0, 2, 3\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(1, 0, 3\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "tile\\(1, 2, 0\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(" 88 "original" } }
+! { dg-final { scan-tree-dump-times "while \\(" 0 "original" } }