From 710700abb804afc0846423ab246034dec745a599 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 27 Jan 2015 20:57:55 +0100 Subject: [PATCH] re PR fortran/63861 (OpenACC coarray ICE (also with OpenMP?)) 2015-01-27 Tobias Burnus 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. From-SVN: r220189 --- gcc/fortran/ChangeLog | 7 ++ gcc/fortran/trans-openmp.c | 24 ++-- gcc/fortran/trans-types.c | 4 + gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 | 108 ++++++++++++++++++ 5 files changed, 139 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 820aad591e5..13cd7509bef 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2015-01-27 Tobias Burnus + + PR fortran/63861 + * 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. + 2015-01-27 Rainer Orth PR fortran/64771 diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index cdd1885262f..8da55d3b467 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -189,7 +189,7 @@ 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)) type = gfc_get_element_type (type); if (TREE_CODE (type) != RECORD_TYPE) @@ -1989,7 +1989,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_DECL (node3) = 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; tree size @@ -2019,16 +2022,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, else_b)); 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 OMP_CLAUSE_DECL (node) = decl; diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 1ee490e35f4..53da053fc4d 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1172,6 +1172,10 @@ gfc_conv_array_bound (gfc_expr * expr) return NULL_TREE; } +/* 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/ChangeLog b/gcc/testsuite/ChangeLog index 8d50aacf55d..6c0f0e19f5a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-27 Tobias Burnus + + PR fortran/63861 + * gfortran.dg/goacc/coarray_2.f90: New. + 2015-01-27 Jan Hubicka PR ipa/60871 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 00000000000..f35d4b9b18e --- /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" } -- 2.30.2