diff mbox

[Fortran] PR63861 - fix OpenMP/ACC's gfc_has_alloc_comps

Message ID 54C3E2A7.1080608@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Jan. 24, 2015, 6:21 p.m. UTC 
gfortran's scalar coarray are special: The descriptorless variant is a 
normal variable with some language-specific additional information 
(corank, bounds). The descriptor variant has a descriptor but the _data 
component is just a pointer to the scalar variable.

As the element type of a descriptorless coarray is the type itself, we 
need to break the while loop.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

PS: I believes coarrays are fine in OpenMP and OpenACC constructs as 
long as the variable is not coindexed ("variable[remove_index]", 
gfc_is_coindexed()). Issues like synchronization is in my opinion purely 
in the responsibility of the user.

Comments

Jakub Jelinek Jan. 26, 2015, 7:59 a.m. UTC | #1 
On Sat, Jan 24, 2015 at 07:21:27PM +0100, Tobias Burnus wrote:
> gfortran's scalar coarray are special: The descriptorless variant is a
> normal variable with some language-specific additional information (corank,
> bounds). The descriptor variant has a descriptor but the _data component is
> just a pointer to the scalar variable.
> 
> As the element type of a descriptorless coarray is the type itself, we need
> to break the while loop.
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?

Won't that break e.g.

subroutine foo
  type x
    integer, allocatable :: y
  end type
  type(x) :: z(2, 2)
  !$omp parallel private (z)
    allocate (z(2, 2)%y)
  !$omp end parallel
end subroutine

In that case I believe we have GFC_ARRAY_TYPE_P and !GFC_DESCRIPTOR_TYPE_P,
and GFC_TYPE_ARRAY_RANK (type) is 2, and the struct has allocatable
components, but we would return that we don't have them?

> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -189,7 +189,8 @@ gfc_has_alloc_comps (tree type, tree decl)
>  	return false;
>      }
>  
> -  while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
> +  if (GFC_DESCRIPTOR_TYPE_P (type)
> +      || (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0))
>      type = gfc_get_element_type (type);
>  
>    if (TREE_CODE (type) != RECORD_TYPE)

	Jakub
diff mbox

Patch

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

	PR fortran/63861
gcc/fortran/
	* trans-openmp.c (gfc_has_alloc_comps): Fix handling for
	scalar coarrays.

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..4c7d82d 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -189,7 +189,8 @@  gfc_has_alloc_comps (tree type, tree decl)
 	return false;
     }
 
-  while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      || (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0))
     type = gfc_get_element_type (type);
 
   if (TREE_CODE (type) != RECORD_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..7fbd928
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90
@@ -0,0 +1,112 @@ 
+! { 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 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 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 oacc2
+
+  subroutine oacc2(a)
+    implicit none
+    integer :: i
+    integer, allocatable, 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 oacc2
+end module test
+! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }