commit d68b49bae714a7b5881587a61d30d643fa0cdb90 Author: Alessandro Fanfarillo Date: Thu Nov 26 18:51:47 2015 +0100 New tests for coarray events and new functions in libcaf_single 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 + Alessandro Fanfarillo + + * gfortran.dg/coarray/event_1.f90: New. + * gfortran.dg/coarray/event_2.f90: New. + 2015-11-25 Markus Trippelsdorf Paolo Carlini 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 + Alessandro Fanfarillo + + * 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 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,