diff options
author | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-07-22 11:58:50 +0200 |
---|---|---|
committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-07-22 11:58:50 +0200 |
commit | 9fe9a3a780c9cd8f5fa45e162640b7169c27fe8f (patch) | |
tree | 1c0f3d1cddd27ab0187228634e40acedd23011c5 | |
parent | 4971dd802d586f57d999152825d407800970be4e (diff) | |
download | gcc-9fe9a3a780c9cd8f5fa45e162640b7169c27fe8f.zip gcc-9fe9a3a780c9cd8f5fa45e162640b7169c27fe8f.tar.gz gcc-9fe9a3a780c9cd8f5fa45e162640b7169c27fe8f.tar.bz2 |
libcaf.h: Add parameter stat to caf_get() and caf_send()'s function prototypes.
libgfortran/ChangeLog:
2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org>
* 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 <vehre@gcc.gnu.org>
* gfortran.dg/coarray_stat_2.f90: New test.
From-SVN: r238636
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_stat_2.f90 | 23 | ||||
-rw-r--r-- | libgfortran/ChangeLog | 10 | ||||
-rw-r--r-- | libgfortran/caf/libcaf.h | 6 | ||||
-rw-r--r-- | libgfortran/caf/single.c | 31 |
5 files changed, 61 insertions, 13 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0a5a032..662eda6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org> + + * gfortran.dg/coarray_stat_2.f90: New test. + 2016-07-21 Michael Meissner <meissner@linux.vnet.ibm.com> * 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 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/ChangeLog b/libgfortran/ChangeLog index 04a708e..8b21527 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org> + + * 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 <jvdelisle@gcc.gnu.org> PR libgfortran/48852 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; } |