single.c (_gfortran_caf_co_reduce): New function.

2015-01-02  Tobias Burnus  <burnus@net-b.de>

        * caf/single.c (_gfortran_caf_co_reduce): New function.
        * caf/libcaf.h (_gfortran_caf_co_reduce): New prototype.

2015-01-02  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray/collectives_4.f90: New.

From-SVN: r219148

gcc/fortran/ChangeLog

@@ -14,7 +14,7 @@
 	* interface.c (is_procptr_result): New function to check if an
 	expression is a procedure-pointer result.
 	(compare_actual_formal): Use it.
-
+^L
 Copyright (C) 2015 Free Software Foundation, Inc.
 
 Copying and distribution of this file, with or without modification,

gcc/testsuite/ChangeLog

+2015-01-02  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/coarray/collectives_4.f90: New.
+
 2015-01-02  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/57562
@@ -18,7 +22,7 @@
 
 	PR fortran/60507
 	* gfortran.dg/dummy_procedure_11.f90: New.
-
+^L
 Copyright (C) 2015 Free Software Foundation, Inc.
 
 Copying and distribution of this file, with or without modification,

gcc/testsuite/gfortran.dg/coarray/collectives_4.f90

+! { dg-do run }
+!
+! CO_REDUCE
+!
+implicit none (type, external)
+intrinsic :: co_reduce
+integer :: stat
+integer :: i4, i4_2, i
+
+i4 = 21 * this_image()
+i4_2 = 21
+do i = 2, num_images()
+  i4_2 = i4_2 * 21 * i
+end do
+call co_reduce(i4, op_i4, stat=stat)
+if (stat /= 0) call abort()
+if (i4_2 /= i4) call abort()
+
+contains
+  pure integer function op_i4(a,b)
+    integer, value :: a, b
+    op_i4 = a * b
+  end function op_i4
+end

libgfortran/caf/libcaf.h

@@ -110,6 +110,8 @@ void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
 void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
 void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, int, int);
 void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, int, int);
+void _gfortran_caf_co_reduce (gfc_descriptor_t *, void* (*) (void *, void*),
+			      int, int, int *, char *, int, int);
 
 void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
                         caf_vector_t *, gfc_descriptor_t *, int, int, bool);

libgfortran/caf/single.c

@@ -254,6 +254,21 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
 }
 
 
+void
+_gfortran_caf_co_reduce (gfc_descriptor_t *a __attribute__ ((unused)),
+                        void * (*opr) (void *, void *)
+                               __attribute__ ((unused)),
+                        int opr_flags __attribute__ ((unused)),
+                        int result_image __attribute__ ((unused)),
+                        int *stat, char *errmsg __attribute__ ((unused)),
+                        int a_len __attribute__ ((unused)),
+                        int errmsg_len __attribute__ ((unused)))
+ {
+   if (stat)
+     *stat = 0;
+ }
+
+
 static void
 assign_char4_from_char1 (size_t dst_size, size_t src_size, uint32_t *dst,
 			 unsigned char *src)