[gomp4] add support for derived types in ACC UPDATE

[Thomas Schwinge]

Hi Cesar!

On Thu, 10 Nov 2016 09:38:33 -0800, Cesar Philippidis <cesar@codesourcery.com> wrote:
> This patch has been committed to gomp-4_0-branch.

> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c

> @@ -242,7 +243,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
>  	case MATCH_YES:
>  	  gfc_expr *expr;
>  	  expr = NULL;
> -	  if (allow_sections && gfc_peek_ascii_char () == '(')
> +	  if (allow_sections && gfc_peek_ascii_char () == '('
> +	      || allow_derived && gfc_peek_ascii_char () == '%')
>  	    {
>  	      gfc_current_locus = cur_loc;
>  	      m = gfc_match_variable (&expr, 0);

    [...]/source-gcc/gcc/fortran/openmp.c: In function 'match {+gfc_match_omp_variable_list(const char*, gfc_omp_namelist**, bool, bool*, gfc_omp_namelist***, bool, bool)':+}
    [...]/source-gcc/gcc/fortran/openmp.c:246:23: warning: suggest parentheses around '&&' within '||' [-Wparentheses]
        if (allow_sections && gfc_peek_ascii_char () == '('
                           ^

> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -1938,7 +1938,66 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
>  	      tree decl = gfc_get_symbol_decl (n->sym);
>  	      if (DECL_P (decl))
>  		TREE_ADDRESSABLE (decl) = 1;
> -	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
> +	      /* Handle derived-typed members for OpenACC Update.  */
> +	      if (n->sym->ts.type == BT_DERIVED
> +		  && n->expr != NULL && n->expr->ref != NULL
> +		  && (n->expr->ref->next == NULL
> +		      || (n->expr->ref->next != NULL
> +			  && n->expr->ref->next->type == REF_ARRAY
> +			  && n->expr->ref->next->u.ar.type == AR_FULL)))
> +		{
> +		  gfc_ref *ref = n->expr->ref;
> +		  tree orig_decl = decl;

    [...]/source-gcc/gcc/fortran/trans-openmp.c: In function 'tree_node* gfc_trans_omp_clauses_1(stmtblock_t*, gfc_omp_clauses*, locus, bool)':
    [...]/source-gcc/gcc/fortran/trans-openmp.c:1947:10: warning: unused variable 'orig_decl' [-Wunused-variable]
         tree orig_decl = decl;
              ^

> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/derived-types.f90
> @@ -0,0 +1,78 @@
> +! Test ACC UPDATE with derived types. The DEVICE clause depends on an
> +! accelerator being present.

I guess that "DEVICE" comment here is a leftover?  (Doesn't apply to a
compile test.)

> +module dt
> +  integer, parameter :: n = 10
> +  type inner
> +     integer :: d(n)
> +  end type inner
> +  type dtype
> +     integer(8) :: a, b, c(n)
> +     type(inner) :: in
> +  end type dtype
> +end module dt
> +
> +program derived_acc
> +  use dt
> +  
> +  implicit none
> +  type(dtype):: var
> +  integer i
> +  !$acc declare create(var)
> +  !$acc declare pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
> +
> +  !$acc update host(var)
> +  !$acc update host(var%a)
> +  !$acc update device(var)
> +  !$acc update device(var%a)
> +[...]

> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/update-2.f90
> @@ -0,0 +1,285 @@
> +! Test ACC UPDATE with derived types. The DEVICE clause depends on an
> +! accelerator being present.

Why?  Shouldn "!$acc update device" just be a no-op for host execution?


Grüße
 Thomas


> +! { dg-do run  { target openacc_nvidia_accel_selected } }
> +
> +module dt
> +  integer, parameter :: n = 10
> +  type inner
> +     integer :: d(n)
> +  end type inner
> +  type mytype
> +     integer(8) :: a, b, c(n)
> +     type(inner) :: in
> +  end type mytype
> +end module dt
> +
> +program derived_acc
> +  use dt
> +
> +  implicit none
> +  integer i, res
> +  type(mytype) :: var
> +
> +  var%a = 0
> +  var%b = 1
> +  var%c(:) = 10
> +  var%in%d(:) = 100
> +
> +  var%c(:) = 10
> +
> +  !$acc enter data copyin(var)
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, 1
> +     var%a = var%b
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%a)
> +
> +  if (var%a /= var%b) call abort
> +
> +  var%b = 100
> +
> +  !$acc update device(var%b)
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, 1
> +     var%a = var%b
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%a)
> +
> +  if (var%a /= var%b) call abort
> +
> +  !$acc parallel loop present (var)
> +  do i = 1, n
> +     var%c(i) = i
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c)
> +
> +  var%a = -1
> +
> +  do i = 1, n
> +     if (var%c(i) /= i) call abort
> +     var%c(i) = var%a
> +  end do
> +
> +  !$acc update device(var%a)
> +  !$acc update device(var%c)
> +
> +  res = 0
> +
> +  !$acc parallel loop present(var) reduction(+:res)
> +  do i = 1, n
> +     if (var%c(i) /= var%a) res = res + 1
> +  end do
> +
> +  if (res /= 0) call abort
> +
> +  var%c(:) = 0
> +
> +  !$acc update device(var%c)
> +
> +  !$acc parallel loop present(var)
> +  do i = 5, 5
> +     var%c(i) = 1
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c(5))
> +
> +  do i = 1, n
> +     if (i /= 5 .and. var%c(i) /= 0) call abort
> +     if (i == 5 .and. var%c(i) /= 1) call abort
> +  end do
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, n
> +     var%in%d = var%a
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%in%d)
> +
> +  do i = 1, n
> +     if (var%in%d(i) /= var%a) call abort
> +  end do
> +
> +  var%c(:) = 0
> +
> +  !$acc update device(var%c)
> +
> +  var%c(:) = -1
> +
> +  !$acc parallel loop present(var)
> +  do i = n/2, n
> +     var%c(i) = i
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c(n/2:n))
> +
> +  do i = 1,n
> +     if (i < n/2 .and. var%c(i) /= -1) call abort
> +     if (i >= n/2 .and. var%c(i) /= i) call abort
> +  end do
> +
> +  var%in%d(:) = 0
> +  !$acc update device(var%in%d)
> +
> +  !$acc parallel loop present(var)
> +  do i = 5, 5
> +     var%in%d(i) = 1
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%in%d(5))
> +
> +  do i = 1, n
> +     if (i /= 5 .and. var%in%d(i) /= 0) call abort
> +     if (i == 5 .and. var%in%d(i) /= 1) call abort
> +  end do
> +
> +  !$acc exit data delete(var)
> +
> +  call derived_acc_subroutine(var)
> +end program derived_acc
> +
> +subroutine derived_acc_subroutine(var)
> +  use dt
> +
> +  implicit none
> +  integer i, res
> +  type(mytype) :: var
> +
> +  var%a = 0
> +  var%b = 1
> +  var%c(:) = 10
> +  var%in%d(:) = 100
> +
> +  var%c(:) = 10
> +
> +  !$acc enter data copyin(var)
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, 1
> +     var%a = var%b
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%a)
> +
> +  if (var%a /= var%b) call abort
> +
> +  var%b = 100
> +
> +  !$acc update device(var%b)
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, 1
> +     var%a = var%b
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%a)
> +
> +  if (var%a /= var%b) call abort
> +
> +  !$acc parallel loop present (var)
> +  do i = 1, n
> +     var%c(i) = i
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c)
> +
> +  var%a = -1
> +
> +  do i = 1, n
> +     if (var%c(i) /= i) call abort
> +     var%c(i) = var%a
> +  end do
> +
> +  !$acc update device(var%a)
> +  !$acc update device(var%c)
> +
> +  res = 0
> +
> +  !$acc parallel loop present(var) reduction(+:res)
> +  do i = 1, n
> +     if (var%c(i) /= var%a) res = res + 1
> +  end do
> +
> +  if (res /= 0) call abort
> +
> +  var%c(:) = 0
> +
> +  !$acc update device(var%c)
> +
> +  !$acc parallel loop present(var)
> +  do i = 5, 5
> +     var%c(i) = 1
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c(5))
> +
> +  do i = 1, n
> +     if (i /= 5 .and. var%c(i) /= 0) call abort
> +     if (i == 5 .and. var%c(i) /= 1) call abort
> +  end do
> +
> +  !$acc parallel loop present(var)
> +  do i = 1, n
> +     var%in%d = var%a
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%in%d)
> +
> +  do i = 1, n
> +     if (var%in%d(i) /= var%a) call abort
> +  end do
> +
> +  var%c(:) = 0
> +
> +  !$acc update device(var%c)
> +
> +  var%c(:) = -1
> +
> +  !$acc parallel loop present(var)
> +  do i = n/2, n
> +     var%c(i) = i
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%c(n/2:n))
> +
> +  do i = 1,n
> +     if (i < n/2 .and. var%c(i) /= -1) call abort
> +     if (i >= n/2 .and. var%c(i) /= i) call abort
> +  end do
> +
> +  var%in%d(:) = 0
> +  !$acc update device(var%in%d)
> +
> +  !$acc parallel loop present(var)
> +  do i = 5, 5
> +     var%in%d(i) = 1
> +  end do
> +  !$acc end parallel loop
> +
> +  !$acc update host(var%in%d(5))
> +
> +  do i = 1, n
> +     if (i /= 5 .and. var%in%d(i) /= 0) call abort
> +     if (i == 5 .and. var%in%d(i) /= 1) call abort
> +  end do
> +
> +  !$acc exit data delete(var)
> +end subroutine derived_acc_subroutine