re PR fortran/63861 (OpenACC coarray ICE (also with OpenMP?))

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.

From-SVN: r220189

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 820aad5..13cd750 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2015-01-27  Tobias Burnus  <burnus@net-b.de>
+
+       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  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        PR fortran/64771

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index cdd1885..8da55d3 100644 (file)
--- 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 1ee490e..53da053 100644 (file)
--- 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;
 }
 \f
+/* 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 8d50aac..6c0f0e1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-27  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/63861
+       * gfortran.dg/goacc/coarray_2.f90: New.
+
 2015-01-27  Jan Hubicka  <hubicka@ucw.cz>
 
        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 (file)
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" }