Hi Paul, hi all,
thanks for the fast review. Committed as r238636.
Thanks again and regards,
Andre
On Thu, 21 Jul 2016 17:44:06 +0200
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Hi Andre,
>
> That looks good to me. OK for trunk.
>
> Thanks for the patch.
>
> Paul
>
> On 21 July 2016 at 15:31, Andre Vehreschild <ve...@gmx.de> wrote:
> > Hi all,
> >
> > the attached patch adds support for a stat parameter to caf_single's
> > caf_get() and caf_send() routines and adds a testcase.
> > Unfortunately is there not much that can go wrong in a caf_single's
> > get/send, so the test resides to check whether stat is reset
> > correctly.
> >
> > Bootstraps and regtests ok on x86_64-linux/F23.
> >
> > Ok for trunk?
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 238634)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,7 @@
+2016-07-22 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ * gfortran.dg/coarray_stat_2.f90: New test.
+
2016-07-21 Michael Meissner <meiss...@linux.vnet.ibm.com>
* gcc.target/powerpc/vec-extract.h: New files to check the
Index: gcc/testsuite/gfortran.dg/coarray_stat_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_stat_2.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_stat_2.f90 (Arbeitskopie)
@@ -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
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog (Revision 238634)
+++ libgfortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+2016-07-22 Andre Vehreschild <ve...@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 <jvdeli...@gcc.gnu.org>
PR libgfortran/48852
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h (Revision 238634)
+++ libgfortran/caf/libcaf.h (Arbeitskopie)
@@ -121,9 +121,11 @@
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);
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c (Revision 238634)
+++ libgfortran/caf/single.c (Arbeitskopie)
@@ -328,7 +328,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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;
}
