diff mbox

[Fortran,v1] Add STAT= support to caf_single get()/send()

Message ID 20160721153102.585a4e8d@vepi2
State New
Headers show

Commit Message

Andre Vehreschild July 21, 2016, 1:31 p.m. UTC
Hi all,

the attached patch adds support for a stat parameter to caf_single's
caf_get() and caf_send() routines and adds a testcase. Unfortunately is
there not much that can go wrong in a caf_single's get/send, so the test
resides to check whether stat is reset correctly. 

Bootstraps and regtests ok on x86_64-linux/F23.

Ok for trunk?

Regards,
	Andre

Comments

Paul Richard Thomas July 21, 2016, 3:44 p.m. UTC | #1
Hi Andre,

That looks good to me. OK for trunk.

Thanks for the patch.

Paul

On 21 July 2016 at 15:31, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> the attached patch adds support for a stat parameter to caf_single's
> caf_get() and caf_send() routines and adds a testcase. Unfortunately is
> there not much that can go wrong in a caf_single's get/send, so the test
> resides to check whether stat is reset correctly.
>
> Bootstraps and regtests ok on x86_64-linux/F23.
>
> Ok for trunk?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox

Patch

diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_2.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_2.f90
new file mode 100644
index 0000000..3bbd3fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_2.f90
@@ -0,0 +1,23 @@ 
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+!
+! Support for stat= in caf reference
+!
+program whitespace
+  implicit none
+
+  integer :: me[*],tmp,stat
+
+  me = this_image()
+  stat = 0
+
+  sync all(stat = stat)
+
+  if(stat /= 0) write(*,*) 'failure during sync'
+
+  stat = 42
+
+  tmp = me[num_images(),stat = stat]
+  if(stat /= 0) call abort()
+
+end program whitespace
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 01a33f9..863b5b4 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -121,9 +121,11 @@  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);
+			caf_vector_t *, gfc_descriptor_t *, int, int, bool,
+			int *);
 void _gfortran_caf_send (caf_token_t, size_t, int, gfc_descriptor_t *,
-			 caf_vector_t *, gfc_descriptor_t *, int, int, bool);
+			 caf_vector_t *, gfc_descriptor_t *, int, int, bool,
+			 int *);
 void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
 			    caf_vector_t *, caf_token_t, size_t, int,
 			    gfc_descriptor_t *, caf_vector_t *, int, int, bool);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index f726537..21916d3 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -328,7 +328,7 @@  assign_char1_from_char4 (size_t dst_size, size_t src_size, unsigned char *dst,
 
 static void
 convert_type (void *dst, int dst_type, int dst_kind, void *src, int src_type,
-	      int src_kind)
+	      int src_kind, int *stat)
 {
 #ifdef HAVE_GFC_INTEGER_16
   typedef __int128 int128t;
@@ -581,7 +581,10 @@  convert_type (void *dst, int dst_type, int dst_kind, void *src, int src_type,
 error:
   fprintf (stderr, "libcaf_single RUNTIME ERROR: Cannot convert type %d kind "
 	   "%d to type %d kind %d\n", src_type, src_kind, dst_type, dst_kind);
-  abort();
+  if (stat)
+    *stat = 1;
+  else
+    abort ();
 }
 
 
@@ -591,7 +594,7 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
 		   gfc_descriptor_t *src,
 		   caf_vector_t *src_vector __attribute__ ((unused)),
 		   gfc_descriptor_t *dest, int src_kind, int dst_kind,
-		   bool may_require_tmp)
+		   bool may_require_tmp, int *stat)
 {
   /* FIXME: Handle vector subscripts.  */
   size_t i, k, size;
@@ -600,6 +603,9 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
   size_t src_size = GFC_DESCRIPTOR_SIZE (src);
   size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
 
+  if (stat)
+    *stat = 0;
+
   if (rank == 0)
     {
       void *sr = (void *) ((char *) TOKEN (token) + offset);
@@ -626,7 +632,7 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
 				 sr);
       else
 	convert_type (GFC_DESCRIPTOR_DATA (dest), GFC_DESCRIPTOR_TYPE (dest),
-		      dst_kind, sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+		      dst_kind, sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
       return;
     }
 
@@ -710,7 +716,7 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
 	    assign_char4_from_char1 (dst_size, src_size, dst, sr);
 	  else
 	    convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-			  sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+			  sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
           array_offset_sr += src_size;
 	}
 
@@ -770,7 +776,7 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
 	assign_char4_from_char1 (dst_size, src_size, dst, sr);
       else
 	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
     }
 }
 
@@ -781,7 +787,7 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
 		    gfc_descriptor_t *dest,
 		    caf_vector_t *dst_vector __attribute__ ((unused)),
 		    gfc_descriptor_t *src, int dst_kind, int src_kind,
-		    bool may_require_tmp)
+		    bool may_require_tmp, int *stat)
 {
   /* FIXME: Handle vector subscripts.  */
   size_t i, k, size;
@@ -790,6 +796,9 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
   size_t src_size = GFC_DESCRIPTOR_SIZE (src);
   size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
 
+  if (stat)
+    *stat = 0;
+
   if (rank == 0)
     {
       void *dst = (void *) ((char *) TOKEN (token) + offset);
@@ -816,7 +825,7 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
       else
 	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
 		      GFC_DESCRIPTOR_DATA (src), GFC_DESCRIPTOR_TYPE (src),
-		      src_kind);
+		      src_kind, stat);
       return;
     }
 
@@ -909,7 +918,7 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
 	    assign_char4_from_char1 (dst_size, src_size, dst, sr);
 	  else
 	    convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-			  sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+			  sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
           if (GFC_DESCRIPTOR_RANK (src))
 	    array_offset_sr += src_size;
 	}
@@ -976,7 +985,7 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
 	assign_char4_from_char1 (dst_size, src_size, dst, sr);
       else
 	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
     }
 }
 
@@ -997,7 +1006,7 @@  _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
   void *src_base = GFC_DESCRIPTOR_DATA (src);
   GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset);
   _gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
-		      src, dst_kind, src_kind, may_require_tmp);
+		      src, dst_kind, src_kind, may_require_tmp, NULL);
   GFC_DESCRIPTOR_DATA (src) = src_base;
 }