From 9fe9a3a780c9cd8f5fa45e162640b7169c27fe8f Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Fri, 22 Jul 2016 11:58:50 +0200 Subject: [PATCH] libcaf.h: Add parameter stat to caf_get() and caf_send()'s function prototypes. libgfortran/ChangeLog: 2016-07-22 Andre Vehreschild * caf/libcaf.h: Add parameter stat to caf_get() and caf_send()'s function prototypes. * caf/single.c (_gfortran_caf_get): Implement reporting error using stat instead of abort(). (_gfortran_caf_send): Same. (_gfortran_caf_sendget): Use NULL for stat when calling caf_send(). gcc/testsuite/ChangeLog: 2016-07-22 Andre Vehreschild * gfortran.dg/coarray_stat_2.f90: New test. From-SVN: r238636 --- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gfortran.dg/coarray_stat_2.f90 | 23 +++++++++++++++ libgfortran/ChangeLog | 10 +++++++ libgfortran/caf/libcaf.h | 6 ++-- libgfortran/caf/single.c | 31 +++++++++++++------- 5 files changed, 61 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_stat_2.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0a5a0329bcf..662eda641ac 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-07-22 Andre Vehreschild + + * gfortran.dg/coarray_stat_2.f90: New test. + 2016-07-21 Michael Meissner * gcc.target/powerpc/vec-extract.h: New files to check the 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 00000000000..3bbd3fc4bfc --- /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/ChangeLog b/libgfortran/ChangeLog index 04a708e17fe..8b21527d0a4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2016-07-22 Andre Vehreschild + + * caf/libcaf.h: Add parameter stat to caf_get() and + caf_send()'s function prototypes. + * caf/single.c (_gfortran_caf_get): Implement reporting + error using stat instead of abort(). + (_gfortran_caf_send): Same. + (_gfortran_caf_sendget): Use NULL for stat when calling + caf_send(). + 2016-06-23 Jerry DeLisle PR libgfortran/48852 diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 01a33f9d0ee..863b5b463d8 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 f726537e788..21916d3ae6f 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; } -- 2.30.2