diff mbox

[gomp4] fortran routine backports

Message ID 565CD8CD.1000402@codesourcery.com
State New
Headers show

Commit Message

Cesar Philippidis Nov. 30, 2015, 11:16 p.m. UTC 
This patch backports the recent fortran routine support changes I've
made in trunk to gomp-4_0-branch. Nothing changed in the fortran front
end, but I corrected a couple of problems with the way that gang, worker
and vector were handled in tree-nested.c. And there's a new test case to
exercise those changes.

This patch has been applied to gomp-4_0-branch.

Cesar
diff mbox

Patch

2015-11-30  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/
	* tree-nested.c (convert_nonlocal_omp_clauses): Handle optional
	arguments for OMP_CLAUSE_{GANG,WORKER,VECTOR}.
	(convert_local_omp_clauses): Likewise

	gcc/testsuite/
	* gfortran.dg/goacc/subroutines.f90: New test.

diff --git a/gcc/testsuite/gfortran.dg/goacc/subroutines.f90 b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90
new file mode 100644
index 0000000..6cab798
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90
@@ -0,0 +1,73 @@ 
+! Exercise how tree-nested.c handles gang, worker vector and seq.
+
+! { dg-do compile } 
+
+program main
+  integer, parameter :: N = 100
+  integer :: nonlocal_arg
+  integer :: nonlocal_a(N)
+  integer :: nonlocal_i
+  integer :: nonlocal_j
+  
+  nonlocal_a (:) = 5
+  nonlocal_arg = 5
+  
+  call local ()
+  call nonlocal ()
+
+contains
+
+  subroutine local ()
+    integer :: local_i
+    integer :: local_arg
+    integer :: local_a(N)
+    integer :: local_j
+    
+    local_a (:) = 5
+    local_arg = 5
+
+    !$acc kernels loop gang(num:local_arg) worker(local_arg) vector(local_arg)
+    do local_i = 1, N
+       local_a(local_i) = 100
+       !$acc loop seq
+       do local_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+
+    !$acc kernels loop gang(static:local_arg) worker(local_arg) &
+    !$acc vector(local_arg)
+    do local_i = 1, N
+       local_a(local_i) = 100
+       !$acc loop seq
+       do local_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+  end subroutine local
+
+  subroutine nonlocal ()
+    nonlocal_a (:) = 5
+    nonlocal_arg = 5
+  
+    !$acc kernels loop gang(num:nonlocal_arg) worker(nonlocal_arg) &
+    !$acc vector(nonlocal_arg)
+    do nonlocal_i = 1, N
+       nonlocal_a(nonlocal_i) = 100
+       !$acc loop seq
+       do nonlocal_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+
+    !$acc kernels loop gang(static:nonlocal_arg) worker(nonlocal_arg) &
+    !$acc vector(nonlocal_arg)
+    do nonlocal_i = 1, N
+       nonlocal_a(nonlocal_i) = 100
+       !$acc loop seq
+       do nonlocal_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+  end subroutine nonlocal
+end program main
diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c
index e321072..1c9849b 100644
--- a/gcc/tree-nested.c
+++ b/gcc/tree-nested.c
@@ -1109,10 +1109,28 @@  convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_NUM_GANGS:
 	case OMP_CLAUSE_NUM_WORKERS:
 	case OMP_CLAUSE_VECTOR_LENGTH:
-	  wi->val_only = true;
-	  wi->is_lhs = false;
-	  convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
-					 &dummy, wi);
+	case OMP_CLAUSE_GANG:
+	case OMP_CLAUSE_WORKER:
+	case OMP_CLAUSE_VECTOR:
+	  /* Several OpenACC clauses have optional arguments.  Check if they
+	     are present.  */
+	  if (OMP_CLAUSE_OPERAND (clause, 0))
+	    {
+	      wi->val_only = true;
+	      wi->is_lhs = false;
+	      convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
+					     &dummy, wi);
+	    }
+
+	  /* The gang clause accepts two arguments.  */
+	  if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
+	      && OMP_CLAUSE_GANG_STATIC_EXPR (clause))
+	    {
+		wi->val_only = true;
+		wi->is_lhs = false;
+		convert_nonlocal_reference_op
+		  (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
+	    }
 	  break;
 
 	case OMP_CLAUSE_DIST_SCHEDULE:
@@ -1176,9 +1194,6 @@  convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_THREADS:
 	case OMP_CLAUSE_SIMD:
 	case OMP_CLAUSE_DEFAULTMAP:
-	case OMP_CLAUSE_GANG:
-	case OMP_CLAUSE_WORKER:
-	case OMP_CLAUSE_VECTOR:
 	case OMP_CLAUSE_SEQ:
 	  break;
 
@@ -1768,10 +1783,28 @@  convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_NUM_GANGS:
 	case OMP_CLAUSE_NUM_WORKERS:
 	case OMP_CLAUSE_VECTOR_LENGTH:
-	  wi->val_only = true;
-	  wi->is_lhs = false;
-	  convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy,
-				      wi);
+	case OMP_CLAUSE_GANG:
+	case OMP_CLAUSE_WORKER:
+	case OMP_CLAUSE_VECTOR:
+	  /* Several OpenACC clauses have optional arguments.  Check if they
+	     are present.  */
+	  if (OMP_CLAUSE_OPERAND (clause, 0))
+	    {
+	      wi->val_only = true;
+	      wi->is_lhs = false;
+	      convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
+					  &dummy, wi);
+	    }
+
+	  /* The gang clause accepts two arguments.  */
+	  if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
+	      && OMP_CLAUSE_GANG_STATIC_EXPR (clause))
+	    {
+		wi->val_only = true;
+		wi->is_lhs = false;
+		convert_nonlocal_reference_op
+		  (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
+	    }
 	  break;
 
 	case OMP_CLAUSE_DIST_SCHEDULE:
@@ -1840,9 +1873,6 @@  convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_THREADS:
 	case OMP_CLAUSE_SIMD:
 	case OMP_CLAUSE_DEFAULTMAP:
-	case OMP_CLAUSE_GANG:
-	case OMP_CLAUSE_WORKER:
-	case OMP_CLAUSE_VECTOR:
 	case OMP_CLAUSE_SEQ:
 	  break;