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
This commit is contained in:
Andre Vehreschild
parent
4971dd802d
commit
9fe9a3a780
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue