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.
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);
