diff mbox

[Fortran] (RFC, Coarray) Implement TS18508's EVENTS

Message ID CAHqFgjX=q2cCADGf6WDV4TEzCQwS=zUB6+c+2AVjnDRPYfcV7w@mail.gmail.com
State New
Headers show

Commit Message

Alessandro Fanfarillo Nov. 26, 2015, 5:55 p.m. UTC 
Hi all,

in attachment the patch for tests and missing functions in
libcaf_single (needed by the test suite).

Built and regtested on x86_64-pc-linux-gnu.

2015-11-26 17:51 GMT+01:00 Steve Kargl <sgk@troutmask.apl.washington.edu>:
> On Wed, Nov 25, 2015 at 06:24:49PM +0100, Alessandro Fanfarillo wrote:
>> Dear all,
>>
>> in attachment the previous patch compatible with the current trunk.
>> The patch also includes the changes introduced in the latest TS 18508.
>>
>> Built and regtested on x86_64-pc-linux-gnu.
>>
>> PS: I will add the test cases in a different patch.
>>
>
> I have now built and regression tested the patch on
> x86_64-*-freebsd and i386-*-freebsd.  There were no
> regressions.  In reading through the patch, nothing
> jumped out at me as suspicious/wrong.  Tobias, this
> is OK to commit.  If you don't committed by Sunday,
> I'll do it for you.
>
> --
> steve
commit d68b49bae714a7b5881587a61d30d643fa0cdb90
Author: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it>
Date:   Thu Nov 26 18:51:47 2015 +0100

    New tests for coarray events and new functions in libcaf_single
diff mbox

Patch

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e0b16f5..bcc99ea 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@ 
+2015-11-26  Tobias Burnus  <burnus@net-b.de>
+	     Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+	* gfortran.dg/coarray/event_1.f90: New.
+	* gfortran.dg/coarray/event_2.f90: New.
+
 2015-11-25  Markus Trippelsdorf  <markus@trippelsdorf.de>
 	    Paolo Carlini  <paolo.carlini@oracle.com>
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_1.f90 b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
new file mode 100644
index 0000000..b4385f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
@@ -0,0 +1,51 @@ 
+! { dg-do run }
+!
+! Run-time test for EVENT_TYPE
+!
+use iso_fortran_env, only: event_type
+implicit none
+
+type(event_type), save :: var[*]
+integer :: count, stat
+
+count = -42
+call event_query (var, count)
+if (count /= 0) call abort()
+
+stat = 99
+event post (var, stat=stat)
+if (stat /= 0) call abort()
+call event_query(var, count, stat=stat)
+if (count /= 1 .or. stat /= 0) call abort()
+
+stat = 99
+event post (var[this_image()])
+call event_query(var, count)
+if (count /= 2) call abort()
+
+stat = 99
+event wait (var)
+call event_query(var, count)
+if (count /= 1) call abort()
+
+stat = 99
+event post (var)
+call event_query(var, count)
+if (count /= 2) call abort()
+
+stat = 99
+event post (var)
+call event_query(var, count)
+if (count /= 3) call abort()
+
+stat = 99
+event wait (var, until_count=2)
+call event_query(var, count)
+if (count /= 1) call abort()
+
+stat = 99
+event wait (var, stat=stat, until_count=1)
+if (stat /= 0) call abort()
+call event_query(event=var, stat=stat, count=count)
+if (count /= 0 .or. stat /= 0) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_2.f90 b/gcc/testsuite/gfortran.dg/coarray/event_2.f90
new file mode 100644
index 0000000..2d451a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/event_2.f90
@@ -0,0 +1,89 @@ 
+! { dg-do run }
+!
+! Run-time test for EVENT_TYPE
+!
+use iso_fortran_env, only: event_type
+implicit none
+
+type(event_type), save, allocatable :: var(:)[:]
+integer :: count, stat
+
+allocate(var(3)[*])
+
+count = -42
+call event_query (var(1), count)
+if (count /= 0) call abort()
+call event_query (var(1), count)
+if (count /= 0) call abort()
+call event_query (var(2), count)
+if (count /= 0) call abort()
+call event_query (var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event post (var(2), stat=stat)
+if (stat /= 0) call abort()
+call event_query (var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count, stat=stat)
+if (count /= 1 .or. stat /= 0) call abort()
+call event_query (var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event post (var(2)[this_image()])
+call event_query(var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count)
+if (count /= 2) call abort()
+call event_query(var(2), count)
+if (count /= 2) call abort()
+call event_query(var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event wait (var(2))
+call event_query(var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count)
+if (count /= 1) call abort()
+call event_query(var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event post (var(2))
+call event_query(var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count)
+if (count /= 2) call abort()
+call event_query(var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event post (var(2))
+call event_query(var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count)
+if (count /= 3) call abort()
+call event_query(var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event wait (var(2), until_count=2)
+call event_query(var(1), count)
+if (count /= 0) call abort()
+call event_query(var(2), count)
+if (count /= 1) call abort()
+call event_query(var(3), count)
+if (count /= 0) call abort()
+
+stat = 99
+event wait (var(2), stat=stat, until_count=1)
+if (stat /= 0) call abort()
+call event_query(event=var(1), stat=stat, count=count)
+if (count /= 0 .or. stat /= 0) call abort()
+call event_query(event=var(2), stat=stat, count=count)
+if (count /= 0 .or. stat /= 0) call abort()
+call event_query(event=var(3), stat=stat, count=count)
+if (count /= 0 .or. stat /= 0) call abort()
+end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 48db71b..4843fd5 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@ 
+2015-11-26  Tobias Burnus  <burnus@net-b.de>
+	    Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
+
+        * caf/libcaf.h (_gfortran_caf_event_post,
+	_gfortran_caf_event_wait,_gfortran_caf_event_query): New prototypes.
+        * caf/single.c (_gfortran_caf_event_post,
+	_gfortran_caf_event_wait,_gfortran_caf_event_query): Implement.
+
 2015-11-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/52251
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 660bd7c..ebda579 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -57,7 +57,9 @@  typedef enum caf_register_t {
   CAF_REGTYPE_COARRAY_ALLOC,
   CAF_REGTYPE_LOCK_STATIC,
   CAF_REGTYPE_LOCK_ALLOC,
-  CAF_REGTYPE_CRITICAL
+  CAF_REGTYPE_CRITICAL,
+  CAF_REGTYPE_EVENT_STATIC,
+  CAF_REGTYPE_EVENT_ALLOC
 }
 caf_register_t;
 
@@ -133,5 +135,8 @@  void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *,
 
 void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int);
 void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
 
 #endif  /* LIBCAF_H  */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 6c58286..9c4b343 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -101,7 +101,8 @@  _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
   void *local;
 
   if (type == CAF_REGTYPE_LOCK_STATIC || type == CAF_REGTYPE_LOCK_ALLOC
-      || type == CAF_REGTYPE_CRITICAL)
+      || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC
+      || type == CAF_REGTYPE_EVENT_ALLOC)
     local = calloc (size, sizeof (bool));
   else
     local = malloc (size);
@@ -133,7 +134,8 @@  _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
     *stat = 0;
 
   if (type == CAF_REGTYPE_COARRAY_STATIC || type == CAF_REGTYPE_LOCK_STATIC
-      || type == CAF_REGTYPE_CRITICAL)
+      || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC
+      || type == CAF_REGTYPE_EVENT_ALLOC)
     {
       caf_static_t *tmp = malloc (sizeof (caf_static_t));
       tmp->prev  = caf_static_list;
@@ -1071,6 +1073,45 @@  _gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset,
     *stat = 0;
 }
 
+void
+_gfortran_caf_event_post (caf_token_t token, size_t index, 
+			  int image_index __attribute__ ((unused)), 
+			  int *stat, char *errmsg __attribute__ ((unused)), 
+			  int errmsg_len __attribute__ ((unused)))
+{
+  uint32_t value = 1;
+  uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t));
+  __atomic_fetch_add (event, (uint32_t) value, __ATOMIC_RELAXED);
+  
+  if(stat)
+    *stat = 0;
+}
+
+void
+_gfortran_caf_event_wait (caf_token_t token, size_t index, 
+			  int until_count, int *stat,
+			  char *errmsg __attribute__ ((unused)), 
+			  int errmsg_len __attribute__ ((unused)))
+{
+  uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t));
+  uint32_t value = (uint32_t)-until_count;
+   __atomic_fetch_add (event, (uint32_t) value, __ATOMIC_RELAXED);
+  
+   if(stat)
+    *stat = 0;    
+}
+
+void
+_gfortran_caf_event_query (caf_token_t token, size_t index, 
+			   int image_index __attribute__ ((unused)), 
+			   int *count, int *stat)
+{
+  uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t));
+  __atomic_load (event, (uint32_t *) count, __ATOMIC_RELAXED);
+  
+  if(stat)
+    *stat = 0;
+}
 
 void
 _gfortran_caf_lock (caf_token_t token, size_t index,