Re: [Patch, Fortran] PR63861 - fix OpenMP/ACC's gfc_has_alloc_comps

[Tobias Burnus <burnus at net-b dot de>]

Updated patch below.

Jakub Jelinek wrote:
> On Mon, Jan 26, 2015 at 01:14:39PM +0100, Tobias Burnus wrote:
> > The question is why I didn't see the nonsense in the test suite. It
> > doesn't seem to be tested for in gcc/testsuite/gfortran.dg/; it might be
> > tested in libgomp/testsuite/ - I don't recall whether I retested after
> > the (incomplete) change back from "if" to "while" + (wrong) rank check.
It does show up in libgomp's alloc-comp-1.f90 â seems I just forgot to 
re-run libgomp's testsuite :-(
(In testsuite/gfortran*, it does not show up.)

> > All: Any preference for "if" or "while" + rank != 0?
> If it works, fine.  But perhaps put there some comment on why
> for rank == 0 arrays get_element_type is undesirable.

I have now used a simple IF, which also avoids the rank check. (With 
while one has an endless loop without.) But I added a comment to 
get_element_type.

Augmenting the test case a bit, lead to another related issue for 
OpenMP's "map". I hope that I got the passed information right.

Build and regtested (testsuite + libgomp) on x86-64-gnu-linux.
OK for the trunk?


There is another issue with reduction, which I defer. [Assignment of "a 
= 0"; I am not sure whether it goes to the realloc on assignment code, 
but for coarrays, no automatic reallocation shall happen (on the host).]


Tobias

2015-01-27  Tobias Burnus  <burnus@net-b.de>

	PR fortran/63861
gcc/fortran/
	* trans-openmp.c (gfc_has_alloc_comps, gfc_trans_omp_clauses):
	Fix handling for scalar coarrays.
	* trans-types.c (gfc_get_element_type): Add comment.

gcc/testsuite/
	* gfortran.dg/goacc/coarray_2.f90: New.

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index cdd1885..8da55d3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -190,5 +190,5 @@ gfc_has_alloc_comps (tree type, tree decl)
     }
 
-  while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
+  if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
     type = gfc_get_element_type (type);
 
@@ -1990,5 +1990,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			= gfc_conv_descriptor_data_get (decl);
 		      OMP_CLAUSE_SIZE (node3) = size_int (0);
-		      if (n->sym->attr.pointer)
+
+		      /* We have to check for n->sym->attr.dimension because
+			 of scalar coarrays.  */
+		      if (n->sym->attr.pointer && n->sym->attr.dimension)
 			{
 			  stmtblock_t cond_block;
@@ -2020,14 +2023,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_SIZE (node) = size;
 			}
-		      else
+		      else if (n->sym->attr.dimension)
 			OMP_CLAUSE_SIZE (node)
 			  = gfc_full_array_size (block, decl,
 						 GFC_TYPE_ARRAY_RANK (type));
-		      tree elemsz
-			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
-		      elemsz = fold_convert (gfc_array_index_type, elemsz);
-		      OMP_CLAUSE_SIZE (node)
-			= fold_build2 (MULT_EXPR, gfc_array_index_type,
-				       OMP_CLAUSE_SIZE (node), elemsz);
+		      if (n->sym->attr.dimension)
+			{
+			  tree elemsz
+			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+			  elemsz = fold_convert (gfc_array_index_type, elemsz);
+			  OMP_CLAUSE_SIZE (node)
+			    = fold_build2 (MULT_EXPR, gfc_array_index_type,
+					   OMP_CLAUSE_SIZE (node), elemsz);
+			}
 		    }
 		  else
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1ee490e..53da053 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1173,4 +1173,8 @@ gfc_conv_array_bound (gfc_expr * expr)
 }
 
+/* Return the type of an element of the array.  Note that scalar coarrays
+   are special.  In particular, for GFC_ARRAY_TYPE_P, the original argument
+   (with POINTER_TYPE stripped) is returned.  */
+
 tree
 gfc_get_element_type (tree type)
diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
new file mode 100644
index 0000000..f35d4b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
@@ -0,0 +1,108 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=lib" }
+!
+! PR fortran/63861
+
+module test
+contains
+  subroutine oacc1(a)
+    implicit none
+    integer :: i
+    integer, codimension[*] :: a
+    !$acc declare device_resident (a)
+    !$acc data copy (a)
+    !$acc end data
+    !$acc data deviceptr (a)
+    !$acc end data
+    !$acc parallel private (a)
+    !$acc end parallel
+    !$acc host_data use_device (a)
+    !$acc end host_data
+    !$acc parallel loop reduction(+:a)
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc parallel loop
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc update device (a)
+    !$acc update host (a)
+    !$acc update self (a)
+  end subroutine oacc1
+
+  subroutine oacc2(a)
+    implicit none
+    integer :: i
+    integer, allocatable, codimension[:] :: a
+    !$acc declare device_resident (a)
+    !$acc data copy (a)
+    !$acc end data
+    !$acc parallel private (a)
+    !$acc end parallel
+! FIXME:
+!       !$acc parallel loop reduction(+:a)
+!       This involves an assignment, which shall not reallocate
+!       the LHS variable. Version without reduction:
+    !$acc parallel loop
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc parallel loop
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc update device (a)
+    !$acc update host (a)
+    !$acc update self (a)
+  end subroutine oacc2
+
+  subroutine oacc3(a)
+    implicit none
+    integer :: i
+    integer, codimension[*] :: a(:)
+    !$acc declare device_resident (a)
+    !$acc data copy (a)
+    !$acc end data
+    !$acc data deviceptr (a)
+    !$acc end data
+    !$acc parallel private (a)
+    !$acc end parallel
+    !$acc host_data use_device (a)
+    !$acc end host_data
+    !$acc parallel loop reduction(+:a)
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc parallel loop
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc update device (a)
+    !$acc update host (a)
+    !$acc update self (a)
+  end subroutine oacc3
+
+  subroutine oacc4(a)
+    implicit none
+    integer :: i
+    integer, allocatable, codimension[:] :: a(:)
+    !$acc declare device_resident (a)
+    !$acc data copy (a)
+    !$acc end data
+    !$acc parallel private (a)
+    !$acc end parallel
+    !$acc parallel loop reduction(+:a)
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc parallel loop
+    do i = 1,5
+    enddo
+    !$acc end parallel loop
+    !$acc update device (a)
+    !$acc update host (a)
+    !$acc update self (a)
+  end subroutine oacc4
+end module test
+! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }