re PR fortran/46874 ([OpenMP] ICE in gfc_conv_descriptor_data_get, at fortran/trans...

	PR fortran/46874
	* trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable
	dummy variables.

	* libgomp.fortran/allocatable6.f90: New test.

From-SVN: r167798

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eddfceb4e8001a643d1f411776084b471ede460e..230724e375d23f2c9b80b362039c09dd21903c41 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-12-14  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/46874
+       * trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable
+       dummy variables.
+
 2010-12-13  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/46201

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index a8c861e253edfb2b07c1cd9d146a9d9dc7b396e2..53eb99990bc4e8618b0ef0a039833b1c2cda7c8c 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -482,13 +482,23 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
   gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
   gfc_expr *e1, *e2, *e3, *e4;
   gfc_ref *ref;
-  tree decl, backend_decl, stmt;
+  tree decl, backend_decl, stmt, type, outer_decl;
   locus old_loc = gfc_current_locus;
   const char *iname;
   gfc_try t;
 
   decl = OMP_CLAUSE_DECL (c);
   gfc_current_locus = where;
+  type = TREE_TYPE (decl);
+  outer_decl = create_tmp_var_raw (type, NULL);
+  if (TREE_CODE (decl) == PARM_DECL
+      && TREE_CODE (type) == REFERENCE_TYPE
+      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
+      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
+    {
+      decl = build_fold_indirect_ref (decl);
+      type = TREE_TYPE (type);
+    }
 
   /* Create a fake symbol for init value.  */
   memset (&init_val_sym, 0, sizeof (init_val_sym));
@@ -507,7 +517,9 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
   outer_sym.attr.dummy = 0;
   outer_sym.attr.result = 0;
   outer_sym.attr.flavor = FL_VARIABLE;
-  outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
+  outer_sym.backend_decl = outer_decl;
+  if (decl != OMP_CLAUSE_DECL (c))
+    outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
 
   /* Create fake symtrees for it.  */
   symtree1 = gfc_new_symtree (&root1, sym->name);
@@ -624,12 +636,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
 
   /* Create the init statement list.  */
   pushlevel (0);
-  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
-      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     {
       /* If decl is an allocatable array, it needs to be allocated
         with the same bounds as the outer var.  */
-      tree type = TREE_TYPE (decl), rank, size, esize, ptr;
+      tree rank, size, esize, ptr;
       stmtblock_t block;
 
       gfc_start_block (&block);
@@ -669,8 +681,8 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
 
   /* Create the merge statement list.  */
   pushlevel (0);
-  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
-      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     {
       /* If decl is an allocatable array, it needs to be deallocated
         afterwards.  */
@@ -691,7 +703,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
 
   /* And stick the placeholder VAR_DECL into the clause as well.  */
-  OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
+  OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
 
   gfc_current_locus = old_loc;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 33be340e9bbb5f4fd6dd5f4fcf9bc7ba75dfe8b4..f73aa035394004e2a25111ba275b396c2bda2bd0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-14  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/46874
+       * libgomp.fortran/allocatable6.f90: New test.
+
 2010-12-14  Alexander Monakov  <amonakov@ispras.ru>
 
        PR rtl-optimization/46875

diff --git a/libgomp/testsuite/libgomp.fortran/allocatable6.f90 b/libgomp/testsuite/libgomp.fortran/allocatable6.f90
new file mode 100644 (file)
index 0000000..47b67aa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable6.f90
@@ -0,0 +1,45 @@
+! PR fortran/46874
+! { dg-do run }
+
+  interface
+    subroutine sub (a, b, c, d, n)
+      integer :: n
+      integer, allocatable :: a(:), b(:), c(:), d(:)
+    end subroutine
+  end interface
+
+  integer, allocatable :: a(:), b(:), c(:), d(:)
+  integer :: i, j
+  allocate (a(50), b(50), c(50), d(50))
+  do i = 1, 50
+    a(i) = 2 + modulo (i, 7)
+    b(i) = 179 - modulo (i, 11)
+  end do
+  c = 0
+  d = 2147483647
+  call sub (a, b, c, d, 50)
+  do i = 1, 50
+    j = 0
+    if (i .eq. 3) then
+      j = 8
+    else if (i .gt. 1 .and. i .lt. 9) then
+      j = 7
+    end if
+    if (c(i) .ne. j) call abort
+    j = 179 - modulo (i, 11)
+    if (i .gt. 1 .and. i .lt. 9) j = i
+    if (d(i) .ne. j) call abort
+  end do
+  deallocate (a, b, c, d)
+end
+
+subroutine sub (a, b, c, d, n)
+  integer :: n
+  integer, allocatable :: a(:), b(:), c(:), d(:)
+!$omp parallel do shared(a, b) reduction(+:c) reduction(min:d)
+  do i = 1, n
+    c(a(i)) = c(a(i)) + 1
+    d(i) = min(d(i), b(i))
+    d(a(i)) = min(d(a(i)), a(i))
+  end do
+end