diff mbox

[committed] Fix OpenMP ICE with private allocatable array dummy argument (PR fortran/77666)

Message ID 20160927075455.GG7282@tucnak.redhat.com
State New
Headers show

Commit Message

Jakub Jelinek Sept. 27, 2016, 7:54 a.m. UTC 
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  <jakub@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.


	Jakub
diff mbox

Patch

--- 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