Hi Cesar!
On Thu, 10 Nov 2016 09:38:33 -0800, Cesar Philippidis <ce...@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
