[committed] Fix OpenMP linear (ref ()) handling in Fortran FE (PR fortran/84418)

Message ID 20180216224457.GF5867@tucnak
State New
Headers show
Series
  • [committed] Fix OpenMP linear (ref ()) handling in Fortran FE (PR fortran/84418)
Related show

Commit Message

Jakub Jelinek Feb. 16, 2018, 10:44 p.m.
Hi!

For ref linear modifier, we don't want to set OMP_CLAUSE_LINEAR_STEP
to the last_step constant converted to the scalar type, but to
a sizetype last_step times the size of the referenced type.
I'm trying to resolve on omp-lang what to do about arrays with descriptors
or scalar allocatables/pointers.

Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk,
queued for backports to 7.4.

2018-02-16  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/84418
	* trans-openmp.c (gfc_trans_omp_clauses): For OMP_CLAUSE_LINEAR_REF
	kind set OMP_CLAUSE_LINEAR_STEP to TYPE_SIZE_UNIT times last_step.

	* libgomp.fortran/pr84418-1.f90: New test.
	* libgomp.fortran/pr84418-2.f90: New test.


	Jakub

Patch

--- gcc/fortran/trans-openmp.c.jj	2018-01-03 10:20:22.811538381 +0100
+++ gcc/fortran/trans-openmp.c	2018-02-16 15:49:02.500756068 +0100
@@ -1949,9 +1949,32 @@  gfc_trans_omp_clauses (stmtblock_t *bloc
 			  }
 			else
 			  {
-			    tree type = gfc_typenode_for_spec (&n->sym->ts);
-			    OMP_CLAUSE_LINEAR_STEP (node)
-			      = fold_convert (type, last_step);
+			    if (kind == OMP_CLAUSE_LINEAR_REF)
+			      {
+				tree type;
+				if (n->sym->attr.flavor == FL_PROCEDURE)
+				  {
+				    type = gfc_get_function_type (n->sym);
+				    type = build_pointer_type (type);
+				  }
+				else
+				  type = gfc_sym_type (n->sym);
+				if (POINTER_TYPE_P (type))
+				  type = TREE_TYPE (type);
+				/* Otherwise to be determined what exactly
+				   should be done.  */
+				tree t = fold_convert (sizetype, last_step);
+				t = size_binop (MULT_EXPR, t,
+						TYPE_SIZE_UNIT (type));
+				OMP_CLAUSE_LINEAR_STEP (node) = t;
+			      }
+			    else
+			      {
+				tree type
+				  = gfc_typenode_for_spec (&n->sym->ts);
+				OMP_CLAUSE_LINEAR_STEP (node)
+				  = fold_convert (type, last_step);
+			      }
 			  }
 			if (n->sym->attr.dimension || n->sym->attr.allocatable)
 			  OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
--- libgomp/testsuite/libgomp.fortran/pr84418-1.f90.jj	2018-02-16 11:59:08.257377822 +0100
+++ libgomp/testsuite/libgomp.fortran/pr84418-1.f90	2018-02-16 11:56:19.761901263 +0100
@@ -0,0 +1,26 @@ 
+! PR fortran/84418
+! { dg-do run { target vect_simd_clones } }
+! { dg-options "-fno-inline" }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+  real :: a(1024), b(1024), c(1024)
+  integer :: i
+  do i = 1, 1024
+    a(i) = 0.5 * i
+    b(i) = 1.5 * i
+  end do
+  !$omp simd
+  do i = 1, 1024
+    c(i) = foo (a(i), b(i))
+  end do
+  do i = 1, 1024
+    if (c(i).ne.(2 * i)) call abort
+  end do
+contains
+  real function foo (x, y)
+    real :: x, y
+    !$omp declare simd linear (ref (x, y))
+    foo = x + y
+  end function
+end
--- libgomp/testsuite/libgomp.fortran/pr84418-2.f90.jj	2018-02-16 16:02:22.858996874 +0100
+++ libgomp/testsuite/libgomp.fortran/pr84418-2.f90	2018-02-16 16:00:24.200952172 +0100
@@ -0,0 +1,35 @@ 
+! PR fortran/84418
+! { dg-do run { target vect_simd_clones } }
+! { dg-options "-fno-inline" }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+  type p
+    integer :: i, j
+  end type
+  type(p) :: a(1024)
+  integer :: b(4,1024), c(1024)
+  integer :: i
+  do i = 1, 1024
+    a(i)%i = 2 * i
+    a(i)%j = 3 * i
+    b(1,i) = 4 * i
+    b(2,i) = 5 * i
+    b(3,i) = 6 * i
+    b(4,i) = 7 * i
+  end do
+  !$omp simd
+  do i = 1, 1024
+    c(i) = foo (a(i), b(:,i))
+  end do
+  do i = 1, 1024
+    if (c(i).ne.(6 * i)) call abort
+  end do
+contains  
+  function foo (x, y)
+    type (p) :: x
+    integer :: y(4), foo
+    !$omp declare simd linear (ref (x, y))
+    foo = x%i + y(1)
+  end function
+end