[patch, committed, coarray_native] Fix CO_REDUCE with RESULT_IMAGE

[Thomas Koenig]

Hi,

I just committed the attached patch to the branch.

I had also merged the trunk to branch previously,
so it should be more or less up to date by now.

Best regards

	Thomas

     Fix CO_REDUCE with RESULT_IMAGE.

     gcc/fortran/ChangeLog:

             * trans-array.c (gfc_conv_ss_descriptor): Use correct ref.
             * trans-intrinsic.c (trans_argument): Use 
gfc_conv_expr_reference.
             * trans-decl.c (gfc_build_builtin_function_decls):
             Correct spec for array.

     libgfortran/ChangeLog:

             * caf_shared/collective_subroutine.c (collsub_reduce_array):
             Fix off by one error for result.

     gcc/testsuite/ChangeLog:

             * gfortran.dg/caf-shared/co_reduce_1.f90: New test.


-------------- next part --------------
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 199bcaed9b1..85ef1537fcd 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3120,7 +3120,6 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
   gfc_ss_info *ss_info;
   gfc_array_info *info;
   tree tmp;
-  gfc_ref *ref;
 
   ss_info = ss->info;
   info = &ss_info->data.array;
@@ -3172,7 +3171,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
 
       if (flag_coarray == GFC_FCOARRAY_SHARED)
 	{
-	  gfc_ref *co_ref = cas_impl_this_image_ref (ref);
+	  gfc_ref *co_ref = cas_impl_this_image_ref (ss_info->expr->ref);
 	  if (co_ref)
 	    tmp = cas_add_this_image_offset (tmp, se.expr, &co_ref->u.ar, true);
 	}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3ecd63d6169..f86f39159c5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4187,7 +4187,7 @@ gfc_build_builtin_function_decls (void)
 
       gfor_fndecl_cas_reduce_array = 
 	gfc_build_library_function_decl_with_spec (
-	  get_identifier (PREFIX("cas_collsub_reduce_array")), ". W r r w w . ",
+	  get_identifier (PREFIX("cas_collsub_reduce_array")), ". w r r w w . ",
 	  void_type_node, 6, pvoid_type_node /* desc.  */,
 	  build_pointer_type (build_function_type_list (void_type_node,
 	      pvoid_type_node, pvoid_type_node, NULL_TREE)) /* assign function.  */,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 13c32957d69..92cdb3e1bdb 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11217,7 +11217,7 @@ trans_argument (gfc_actual_arglist **curr_al, stmtblock_t *blk,
   if (expr->rank > 0)
     gfc_conv_expr_descriptor (argse, expr);
   else
-    gfc_conv_expr (argse, expr);
+    gfc_conv_expr_reference (argse, expr);
 
   gfc_add_block_to_block (blk, &argse->pre);
   gfc_add_block_to_block (postblk, &argse->post);
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/co_reduce_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/co_reduce_1.f90
new file mode 100644
index 00000000000..ab8b2877295
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/co_reduce_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! This test only works with four images, it will fail otherwise.
+program main
+  implicit none
+  integer, parameter :: n = 3
+  integer, dimension(n) :: a
+  a = [1,2,3] + this_image()
+  call co_reduce (a, mysum, result_image = 2)
+  if (this_image () == 2) then
+     if (any(a /= [14,18,22])) then
+        print *,a
+        print *,a /= [14,18,22]
+        print *,any(a /= [14,18,22])
+        stop 1
+     end if
+  end if
+contains
+  PURE FUNCTION mysum (lhs,rhs)
+    integer, intent(in) :: lhs, rhs
+    integer :: mysum
+    mysum = lhs + rhs
+  END FUNCTION mysum
+end program main
diff --git a/libgfortran/caf_shared/collective_subroutine.c b/libgfortran/caf_shared/collective_subroutine.c
index 875eb946e60..a39f0ae390f 100644
--- a/libgfortran/caf_shared/collective_subroutine.c
+++ b/libgfortran/caf_shared/collective_subroutine.c
@@ -121,7 +121,7 @@ collsub_reduce_array (collsub_iface *ci, gfc_array_char *desc,
   for (; (local->total_num_images >> cbit) != 0; cbit++)
     collsub_sync (ci);
 
-  if (!result_image || *result_image == this_image.image_num)
+  if (!result_image || (*result_image - 1 ) == this_image.image_num)
     {
       if (packed)
 	memcpy (GFC_DESCRIPTOR_DATA (desc), buffer, this_image_size_bytes);