Hi!

The following testcase ICEs, because we need the outer reference for the
private clause to find out if it is allocated or not and the dimensions,
but while it is provided e.g. for automatic array allocatables or all scalar
allocatables, it isn't provided for dummy array allocatable arguments.

Fixed thusly, bootstrapped/regtested on x86_64-linux and i686-linux,
committed to trunk so far.

2016-09-27  Jakub Jelinek  <ja...@redhat.com>

        PR fortran/77666
        * trans-openmp.c (gfc_omp_private_outer_ref): Return true even for
        references to allocatable arrays.

        * gfortran.dg/gomp/pr77666.f90: New test.

--- gcc/fortran/trans-openmp.c.jj       2016-09-13 10:43:58.000000000 +0200
+++ gcc/fortran/trans-openmp.c  2016-09-26 16:05:33.561074532 +0200
@@ -207,6 +207,9 @@ gfc_omp_private_outer_ref (tree decl)
 {
   tree type = TREE_TYPE (decl);
 
+  if (gfc_omp_privatize_by_reference (decl))
+    type = TREE_TYPE (type);
+
   if (GFC_DESCRIPTOR_TYPE_P (type)
       && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     return true;
@@ -214,9 +217,6 @@ gfc_omp_private_outer_ref (tree decl)
   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     return true;
 
-  if (gfc_omp_privatize_by_reference (decl))
-    type = TREE_TYPE (type);
-
   if (gfc_has_alloc_comps (type, decl))
     return true;
 
--- gcc/testsuite/gfortran.dg/gomp/pr77666.f90.jj       2016-09-26 
16:36:19.548421888 +0200
+++ gcc/testsuite/gfortran.dg/gomp/pr77666.f90  2016-09-26 16:35:56.000000000 
+0200
@@ -0,0 +1,26 @@
+! PR fortran/77666
+! { dg-do compile }
+
+subroutine foo(x)
+  interface
+    subroutine baz(x, y)
+      integer, allocatable :: x(:), y
+    end subroutine
+  end interface
+  integer, allocatable :: x(:), y
+!$omp parallel private(x, y)
+  call baz (x, y)
+!$omp end parallel
+end
+subroutine bar
+  interface
+    subroutine baz(x, y)
+      integer, allocatable :: x(:), y
+    end subroutine
+  end interface
+  integer, allocatable :: x(:), y
+  call baz (x, y)
+!$omp parallel private(x, y)
+  call baz (x, y)
+!$omp end parallel
+end

        Jakub

Reply via email to