[PATCH] Fix handling of allocatable dummy vars in reduction (PR fortran/46874)

[Jakub Jelinek <jakub at redhat dot com>]

Hi!

gfc_trans_omp_array_reduction wasn't expecting that allocatable dummy vars
are REFERENCEs to the actual desriptor.

Fixed thusly, bootstrapped/regtested on x86_64-linux and i686-linux, will
commit soon.

2010-12-14  Jakub Jelinek  <jakub@redhat.com>

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

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

--- gcc/fortran/trans-openmp.c.jj	2010-12-06 08:08:48.000000000 +0100
+++ gcc/fortran/trans-openmp.c	2010-12-13 22:18:37.000000000 +0100
@@ -482,13 +482,23 @@ gfc_trans_omp_array_reduction (tree c, g
   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, g
   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, g
 
   /* 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, g
 
   /* 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, g
   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;
 
--- libgomp/testsuite/libgomp.fortran/allocatable6.f90.jj	2010-12-13 22:40:27.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/allocatable6.f90	2010-12-13 22:38:56.000000000 +0100
@@ -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

	Jakub