* [PATCH, Fortran, Coarray, v1] Add support for failed images
@ 2017-03-04 17:59 Andre Vehreschild
2017-03-04 19:52 ` Alessandro Fanfarillo
2017-03-04 23:06 ` Jerry DeLisle
0 siblings, 2 replies; 9+ messages in thread
From: Andre Vehreschild @ 2017-03-04 17:59 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML; +Cc: Alessandro Fanfarillo, Damian Rouson
[-- Attachment #1: Type: text/plain, Size: 539 bytes --]
Hi all,
attached patch polishes the one begun by Alessandro. It adds documentation and
fixes the style issues. Furthermore did I try to interpret the standard
according to the FAIL IMAGE statement. IMHO should it just quit the executable
without any error code. The caf_single library emits "FAIL IMAGE" to stderr,
while in coarray=single mode it just quits. What do you think?
Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be later).
Gruß,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: failed_images_v1.clog --]
[-- Type: text/plain, Size: 3236 bytes --]
gcc/fortran/ChangeLog:
2017-03-04 Andre Vehreschild <vehre@gcc.gnu.org>
* check.c (positive_check): Add new function checking constant for
being greater then zero.
(gfc_check_image_status): Add checking of image_status arguments.
(gfc_check_failed_or_stopped_images): Same but for failed_- and
stopped_images function.
* dump-parse-tree.c (show_code_node): Added output of FAIL IMAGE.
* gfortran.h (enum gfc_statement): Added FAIL_IMAGE_ST.
(enum gfc_isym_id): Added new intrinsic symbols.
(enum gfc_exec_op): Added EXEC_FAIL_IMAGE.
* gfortran.texi: Added description for the new API functions. Updated
coverage of gfortran of TS18508.
* intrinsic.c (add_functions): Added symbols to resolve new intrinsic
functions.
* intrinsic.h: Added prototypes.
* iresolve.c (gfc_resolve_failed_images): Resolve the failed_images
intrinsic.
(gfc_resolve_image_status): Same for image_status.
(gfc_resolve_stopped_images): Same for stopped_images.
* libgfortran.h: Added prototypes.
* match.c (gfc_match_if): Added matching of FAIL IMAGE statement.
(gfc_match_fail_image): Match a FAIL IMAGE statement.
* match.h: Added prototype.
* parse.c (decode_statement): Added matching for FAIL IMAGE.
(next_statement): Same.
(gfc_ascii_statement): Same.
* resolve.c: Same.
* simplify.c (gfc_simplify_failed_or_stopped_images): For COARRAY=
single a constant result can be returne.d
(gfc_simplify_image_status): For COARRAY=single the result is constant.
* st.c (gfc_free_statement): Added FAIL_IMAGE handling.
* trans-decl.c (gfc_build_builtin_function_decls): Added decls of the
new intrinsics.
* trans-expr.c (gfc_conv_procedure_call): This is first time all
arguments of a function are optional, which is now handled here
correctly.
* trans-intrinsic.c (conv_intrinsic_image_status): Translate
image_status.
(gfc_conv_intrinsic_function): Add support for image_status.
(gfc_is_intrinsic_libcall): Add support for the remaining new
intrinsics.
* trans-stmt.c (gfc_trans_fail_image): Trans a fail image.
* trans-stmt.h: Add the prototype for the above.
* trans.c (trans_code): Dispatch for fail_image.
* trans.h: Add the trees for the new intrinsics.
libgfortran/ChangeLog:
2017-03-04 Andre Vehreschild <vehre@gcc.gnu.org>
* caf/libcaf.h: Added prototypes and stat codes for failed and stopped
images.
* caf/single.c (void _gfortran_caf_fail_image): Add the routine.
(int _gfortran_caf_image_status): Same.
(_gfortran_caf_failed_images): Same.
(_gfortran_caf_stopped_images): Same.
gcc/testsuite/ChangeLog:
2017-03-04 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/coarray/fail_image_1.f08: New test.
* gfortran.dg/coarray/fail_image_2.f08: New test.
* gfortran.dg/coarray/failed_images_1.f08: New test.
* gfortran.dg/coarray/failed_images_2.f08: New test.
* gfortran.dg/coarray/image_status_1.f08: New test.
* gfortran.dg/coarray/image_status_2.f08: New test.
* gfortran.dg/coarray/stopped_images_1.f08: New test.
* gfortran.dg/coarray/stopped_images_2.f08: New test.
* gfortran.dg/coarray_fail_st.f90: New test.
* gfortran.dg/coarray_failed_images_1.f08: New test.
* gfortran.dg/coarray_image_status_1.f08: New test.
* gfortran.dg/coarray_stopped_images_1.f08: New test.
[-- Attachment #3: failed_images_v1.patch --]
[-- Type: text/x-patch, Size: 49759 bytes --]
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c22bfa9..45bc68e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -295,6 +295,29 @@ nonnegative_check (const char *arg, gfc_expr *expr)
}
+/* If expr is a constant, then check to ensure that it is greater than zero. */
+
+static bool
+positive_check (int n, gfc_expr *expr)
+{
+ int i;
+
+ if (expr->expr_type == EXPR_CONSTANT)
+ {
+ gfc_extract_int (expr, &i);
+ if (i <= 0)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be positive",
+ gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+ &expr->where);
+ return false;
+ }
+ }
+
+ return true;
+}
+
+
/* If expr2 is constant, then check that the value is less than
(less than or equal to, if 'or_equal' is true) bit_size(expr1). */
@@ -1138,6 +1161,60 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom, gfc_expr *stat)
bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+ /* IMAGE has to be a positive, scalar integer. */
+ if (!type_check (image, 0, BT_INTEGER) || !scalar_check (image, 0)
+ || !positive_check (0, image))
+ return false;
+
+ if (team)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+ gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+ &team->where);
+ return false;
+ }
+ return true;
+}
+
+
+bool
+gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
+{
+ if (team)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+ gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+ &team->where);
+ return false;
+ }
+
+ if (kind)
+ {
+ int k;
+
+ if (!type_check (kind, 1, BT_INTEGER) || !scalar_check (kind, 1)
+ || !positive_check (1, kind))
+ return false;
+
+ /* Get the kind, reporting error on non-constant or overflow. */
+ gfc_current_locus = kind->where;
+ if (gfc_extract_int (kind, &k, 1))
+ return false;
+ if (gfc_validate_kind (BT_INTEGER, k, true) == -1)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L shall specify a "
+ "valid integer kind", gfc_current_intrinsic_arg[1]->name,
+ gfc_current_intrinsic, &kind->where);
+ return false;
+ }
+ }
+ return true;
+}
+
+
+bool
gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
gfc_expr *new_val, gfc_expr *stat)
{
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 36fc4cc..87a5304 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1818,6 +1818,10 @@ show_code_node (int level, gfc_code *c)
break;
+ case EXEC_FAIL_IMAGE:
+ fputs ("FAIL IMAGE ", dumpfile);
+ break;
+
case EXEC_SYNC_ALL:
fputs ("SYNC ALL ", dumpfile);
if (c->expr2 != NULL)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 814ce78..2936550 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -263,7 +263,7 @@ enum gfc_statement
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
- ST_EVENT_WAIT,ST_NONE
+ ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -429,6 +429,7 @@ enum gfc_isym_id
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
GFC_ISYM_EXTENDS_TYPE_OF,
+ GFC_ISYM_FAILED_IMAGES,
GFC_ISYM_FDATE,
GFC_ISYM_FE_RUNTIME_ERROR,
GFC_ISYM_FGET,
@@ -472,6 +473,7 @@ enum gfc_isym_id
GFC_ISYM_IEOR,
GFC_ISYM_IERRNO,
GFC_ISYM_IMAGE_INDEX,
+ GFC_ISYM_IMAGE_STATUS,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_INT2,
@@ -585,6 +587,7 @@ enum gfc_isym_id
GFC_ISYM_SRAND,
GFC_ISYM_SR_KIND,
GFC_ISYM_STAT,
+ GFC_ISYM_STOPPED_IMAGES,
GFC_ISYM_STORAGE_SIZE,
GFC_ISYM_STRIDE,
GFC_ISYM_SUM,
@@ -2457,7 +2460,7 @@ enum gfc_exec_op
EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
- EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT,
+ EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE,
EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index ed9aa93..85afdda 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1125,7 +1125,7 @@ of @code{BIND(C) procedures.}
@item GNU Fortran's implementation for variables with @code{ASYNCHRONOUS}
attribute is compatible with TS 29113.
-@item Assumed types (@code{TYPE(*)}.
+@item Assumed types (@code{TYPE(*)}).
@item Assumed-rank (@code{DIMENSION(..)}). However, the array descriptor
of the TS is not yet supported.
@@ -1147,6 +1147,10 @@ do not support polymorphic types or types with allocatable, pointer or
polymorphic components.
@item Events (@code{EVENT POST}, @code{EVENT WAIT}, @code{EVENT_QUERY})
+
+@item Failed images (@code{FAIL IMAGE}, @code{IMAGE_STATUS},
+@code{FAILED_IMAGES}, @code{STOPPED_IMAGES})
+
@end itemize
@@ -3873,6 +3877,7 @@ of such a type
* caf_register_t::
* caf_deregister_t::
* caf_reference_t::
+* caf_team_t::
@end menu
@node caf_token_t
@@ -4035,6 +4040,11 @@ type conversion still needs to take place the type is transported here.
At the moment @code{CAF_ARR_REF_VECTOR} is not implemented in the front end for
descriptor-less arrays. The library caf_single has untested support for it.
+@node caf_team_t
+@subsection @code{caf_team_t}
+
+Opaque pointer to represent a team-handle. This type is a stand-in for the
+future implementation of teams. It is about to change without further notice.
@node Function ABI Documentation
@section Function ABI Documentation
@@ -4044,6 +4054,9 @@ descriptor-less arrays. The library caf_single has untested support for it.
* _gfortran_caf_finish:: Finalization function
* _gfortran_caf_this_image:: Querying the image number
* _gfortran_caf_num_images:: Querying the maximal number of images
+* _gfortran_caf_image_status :: Query the status of an image
+* _gfortran_caf_failed_images :: Get an array of the indexes of the failed images
+* _gfortran_caf_stopped_images :: Get an array of the indexes of the stopped images
* _gfortran_caf_register:: Registering coarrays
* _gfortran_caf_deregister:: Deregistering coarrays
* _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated
@@ -4063,6 +4076,7 @@ descriptor-less arrays. The library caf_single has untested support for it.
* _gfortran_caf_sync_memory:: Wait for completion of segment-memory operations
* _gfortran_caf_error_stop:: Error termination with exit code
* _gfortran_caf_error_stop_str:: Error termination with string
+* _gfortran_caf_fail_image :: Mark the image failed and end its execution
* _gfortran_caf_atomic_define:: Atomic variable assignment
* _gfortran_caf_atomic_ref:: Atomic variable reference
* _gfortran_caf_atomic_cas:: Atomic compare and swap
@@ -4182,6 +4196,90 @@ then the compiler passes @code{distance=0} and @code{failed=-1} to the function.
@end table
+@node _gfortran_caf_image_status
+@subsection @code{_gfortran_caf_image_status} --- Query the status of an image
+@cindex Coarray, _gfortran_caf_image_status
+
+@table @asis
+@item @emph{Description}:
+Get the status of the image given by the id @var{image} of the team given by
+@var{team}. Valid results are zero, for image is ok, @code{STAT_STOPPED_IMAGE}
+from the ISO_FORTRAN_ENV module to indicate that the image has been stopped and
+@code{STAT_FAILED_IMAGE} also from ISO_FORTRAN_ENV to indicate that the image
+has executed a @code{FAIL IMAGE} statement.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_image_status (int image, caf_team_t * team)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{image} @tab the positive scalar id of the image in the current TEAM.
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_failed_images
+@subsection @code{_gfortran_caf_failed_images} --- Get an array of the indexes of the failed images
+@cindex Coarray, _gfortran_caf_failed_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have failed. The
+array is sorted ascendingly. When @var{team} is not provided the current team
+is to be used. When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind. The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_failed_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_stopped_images
+@subsection @code{_gfortran_caf_stopped_images} --- Get an array of the indexes of the stopped images
+@cindex Coarray, _gfortran_caf_stopped_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have stopped. The
+array is sorted ascendingly. When @var{team} is not provided the current team
+is to be used. When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind. The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_stopped_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
@node _gfortran_caf_register
@subsection @code{_gfortran_caf_register} --- Registering coarrays
@cindex Coarray, _gfortran_caf_register
@@ -4993,6 +5091,24 @@ function should terminate the program with a nonzero-exit code.
+@node _gfortran_caf_fail_image
+@subsection @code{_gfortran_caf_fail_image} --- Mark the image failed and end its execution
+@cindex Coarray, _gfortran_caf_fail_image
+
+@table @asis
+@item @emph{Description}:
+Invoked for an @code{FAIL IMAGE} statement. The function should terminate the
+current image.
+
+@item @emph{Syntax}:
+@code{void _gfortran_caf_fail_image ()}
+
+@item @emph{NOTES}
+This function follows TS18508.
+@end table
+
+
+
@node _gfortran_caf_atomic_define
@subsection @code{_gfortran_caf_atomic_define} --- Atomic variable assignment
@cindex Coarray, _gfortran_caf_atomic_define
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 923572d..2f60fe8 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1840,6 +1840,13 @@ add_functions (void)
a, BT_UNKNOWN, 0, REQUIRED,
mo, BT_UNKNOWN, 0, REQUIRED);
+ add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL,
+ ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+ gfc_check_failed_or_stopped_images,
+ gfc_simplify_failed_or_stopped_images,
+ gfc_resolve_failed_images, "team", BT_VOID, di, OPTIONAL,
+ "kind", BT_INTEGER, di, OPTIONAL);
+
add_sym_0 ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
@@ -2081,6 +2088,11 @@ add_functions (void)
gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
+ add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
+ BT_INTEGER, di, GFC_STD_F2008_TS, gfc_check_image_status,
+ gfc_simplify_image_status, gfc_resolve_image_status, "image",
+ BT_INTEGER, di, REQUIRED, "team", BT_VOID, di, OPTIONAL);
+
/* The resolution function for INDEX is called gfc_resolve_index_func
because the name gfc_resolve_index is already used in resolve.c. */
add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
@@ -2989,6 +3001,13 @@ add_functions (void)
make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
+ add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
+ ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+ gfc_check_failed_or_stopped_images,
+ gfc_simplify_failed_or_stopped_images,
+ gfc_resolve_stopped_images, "team", BT_VOID, di, OPTIONAL,
+ "kind", BT_INTEGER, di, OPTIONAL);
+
add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_storage_size, gfc_simplify_storage_size,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 756c5c6..e8280f6 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -71,6 +71,7 @@ bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_dtime_etime (gfc_expr *);
bool gfc_check_event_query (gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_failed_or_stopped_images (gfc_expr *, gfc_expr *);
bool gfc_check_fgetputc (gfc_expr *, gfc_expr *);
bool gfc_check_fgetput (gfc_expr *);
bool gfc_check_float (gfc_expr *);
@@ -92,6 +93,7 @@ bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
bool gfc_check_idnint (gfc_expr *);
bool gfc_check_ieor (gfc_expr *, gfc_expr *);
+bool gfc_check_image_status (gfc_expr *, gfc_expr *);
bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_int (gfc_expr *, gfc_expr *);
bool gfc_check_intconv (gfc_expr *);
@@ -292,6 +294,7 @@ gfc_expr *gfc_simplify_erfc_scaled (gfc_expr *);
gfc_expr *gfc_simplify_exp (gfc_expr *);
gfc_expr *gfc_simplify_exponent (gfc_expr *);
gfc_expr *gfc_simplify_extends_type_of (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_failed_or_stopped_images (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_float (gfc_expr *);
gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_fraction (gfc_expr *);
@@ -308,6 +311,7 @@ gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_int2 (gfc_expr *);
@@ -473,6 +477,7 @@ void gfc_resolve_event_query (gfc_code *);
void gfc_resolve_exp (gfc_expr *, gfc_expr *);
void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_failed_images (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_fdate (gfc_expr *);
void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
@@ -496,6 +501,7 @@ void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
void gfc_resolve_ierrno (gfc_expr *);
@@ -571,12 +577,13 @@ void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_sin (gfc_expr *, gfc_expr *);
void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_stopped_images (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a, gfc_expr *kind);
+void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_srand (gfc_code *);
void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index f5a4462..b784ac3 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2830,6 +2830,38 @@ gfc_resolve_atan2d (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
}
+/* Resolve failed_images (team, kind). */
+
+void
+gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ static char failed_images[] = "_gfortran_caf_failed_images";
+ f->rank = 1;
+ f->ts.type = BT_INTEGER;
+ if (kind == NULL)
+ f->ts.kind = gfc_default_integer_kind;
+ else
+ gfc_extract_int (kind, &f->ts.kind);
+ f->value.function.name = failed_images;
+}
+
+
+/* Resolve image_status (image, team). */
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
+ gfc_expr *team ATTRIBUTE_UNUSED)
+{
+ static char image_status[] = "_gfortran_caf_image_status";
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = image_status;
+}
+
+
+/* Resolve image_index (...). */
+
void
gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
gfc_expr *sub ATTRIBUTE_UNUSED)
@@ -2841,6 +2873,23 @@ gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
}
+/* Resolve stopped_images (team, kind). */
+
+void
+gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ static char stopped_images[] = "_gfortran_caf_stopped_images";
+ f->rank = 1;
+ f->ts.type = BT_INTEGER;
+ if (kind == NULL)
+ f->ts.kind = gfc_default_integer_kind;
+ else
+ gfc_extract_int (kind, &f->ts.kind);
+ f->value.function.name = stopped_images;
+}
+
+
void
gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *distance ATTRIBUTE_UNUSED)
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 9f657bd..c5ff992 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -117,14 +117,14 @@ typedef enum
}
libgfortran_error_codes;
-/* Must kept in sync with libgfortrancaf.h. */
+/* Must kept in sync with libgfortran/caf/libcaf.h. */
typedef enum
{
GFC_STAT_UNLOCKED = 0,
GFC_STAT_LOCKED,
GFC_STAT_LOCKED_OTHER_IMAGE,
GFC_STAT_STOPPED_IMAGE = 6000, /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */
- GFC_STAT_FAILED_IMAGE
+ GFC_STAT_FAILED_IMAGE = 6001
}
libgfortran_stat_codes;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index fc37f22..a47585c 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1601,6 +1601,7 @@ gfc_match_if (gfc_statement *if_type)
match ("event post", gfc_match_event_post, ST_EVENT_POST)
match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
match ("exit", gfc_match_exit, ST_EXIT)
+ match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
@@ -3265,6 +3266,28 @@ gfc_match_event_wait (void)
}
+/* Match a FAIL IMAGE statement. */
+
+match
+gfc_match_fail_image (void)
+{
+ if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+ return MATCH_ERROR;
+
+ if (gfc_match_char ('(') == MATCH_YES)
+ goto syntax;
+
+ new_st.op = EXEC_FAIL_IMAGE;
+
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (ST_FAIL_IMAGE);
+
+ return MATCH_ERROR;
+}
+
+
/* Match LOCK/UNLOCK statement. Syntax:
LOCK ( lock-variable [ , lock-stat-list ] )
UNLOCK ( lock-variable [ , sync-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index c8e8fc1..64f2038 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -73,6 +73,7 @@ match gfc_match_elseif (void);
match gfc_match_event_post (void);
match gfc_match_event_wait (void);
match gfc_match_critical (void);
+match gfc_match_fail_image (void);
match gfc_match_block (void);
match gfc_match_associate (void);
match gfc_match_do (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 3c568ee..28fa218 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -488,6 +488,7 @@ decode_statement (void)
break;
case 'f':
+ match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
match ("final", gfc_match_final_decl, ST_FINAL);
match ("flush", gfc_match_flush, ST_FLUSH);
match ("format", gfc_match_format, ST_FORMAT);
@@ -1499,7 +1500,7 @@ next_statement (void)
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
case ST_ERROR_STOP: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
- case ST_EVENT_POST: case ST_EVENT_WAIT: \
+ case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
@@ -1827,6 +1828,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_EVENT_WAIT:
p = "EVENT WAIT";
break;
+ case ST_FAIL_IMAGE:
+ p = "FAIL IMAGE";
+ break;
case ST_END_ASSOCIATE:
p = "END ASSOCIATE";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 37ffde8..1fbc9f6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10883,6 +10883,9 @@ start:
resolve_lock_unlock_event (code);
break;
+ case EXEC_FAIL_IMAGE:
+ break;
+
case EXEC_ENTRY:
/* Keep track of which entry we are up to. */
current_entry_id = code->ext.entry->id;
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8ffe75a..169aef1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2466,6 +2466,37 @@ gfc_simplify_exponent (gfc_expr *x)
gfc_expr *
+gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ if (flag_coarray == GFC_FCOARRAY_NONE)
+ {
+ gfc_current_locus = *gfc_current_intrinsic_where;
+ gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+ return &gfc_bad_expr;
+ }
+
+ if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ {
+ gfc_expr *result;
+ int actual_kind;
+ if (kind)
+ gfc_extract_int (kind, &actual_kind);
+ else
+ actual_kind = gfc_default_integer_kind;
+
+ result = gfc_get_array_expr (BT_INTEGER, actual_kind, &gfc_current_locus);
+ result->rank = 1;
+ return result;
+ }
+
+ /* For fcoarray = lib no simplification is possible, because it is not known
+ what images failed or are stopped at compile time. */
+ return NULL;
+}
+
+
+gfc_expr *
gfc_simplify_float (gfc_expr *a)
{
gfc_expr *result;
@@ -6763,6 +6794,36 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
return result;
}
+gfc_expr *
+gfc_simplify_image_status (gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+ if (flag_coarray == GFC_FCOARRAY_NONE)
+ {
+ gfc_current_locus = *gfc_current_intrinsic_where;
+ gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+ return &gfc_bad_expr;
+ }
+
+ /* Simplification is possible for fcoarray = single only. For all other modes
+ the result depends on runtime conditions. */
+ if (flag_coarray != GFC_FCOARRAY_SINGLE)
+ return NULL;
+
+ if (gfc_is_constant_expr (image))
+ {
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+ &image->where);
+ if (mpz_get_si (image->value.integer) == 1)
+ mpz_set_si (result->value.integer, 0);
+ else
+ mpz_set_si (result->value.integer, GFC_STAT_STOPPED_IMAGE);
+ return result;
+ }
+ else
+ return NULL;
+}
+
gfc_expr *
gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim,
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index acef6cf..bffe50d 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -120,6 +120,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_UNLOCK:
case EXEC_EVENT_POST:
case EXEC_EVENT_WAIT:
+ case EXEC_FAIL_IMAGE:
break;
case EXEC_BLOCK:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 41b36a5..449ca9a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -153,6 +153,10 @@ tree gfor_fndecl_caf_unlock;
tree gfor_fndecl_caf_event_post;
tree gfor_fndecl_caf_event_wait;
tree gfor_fndecl_caf_event_query;
+tree gfor_fndecl_caf_fail_image;
+tree gfor_fndecl_caf_failed_images;
+tree gfor_fndecl_caf_image_status;
+tree gfor_fndecl_caf_stopped_images;
tree gfor_fndecl_co_broadcast;
tree gfor_fndecl_co_max;
tree gfor_fndecl_co_min;
@@ -3732,6 +3736,28 @@ gfc_build_builtin_function_decls (void)
void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
pint_type, pint_type);
+ gfor_fndecl_caf_fail_image = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_fail_image")), void_type_node, 0);
+ /* CAF's FAIL doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image) = 1;
+
+ gfor_fndecl_caf_failed_images
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_failed_images")), "WRR",
+ void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+ integer_type_node);
+
+ gfor_fndecl_caf_image_status
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_image_status")), "RR",
+ integer_type_node, 2, integer_type_node, ppvoid_type_node);
+
+ gfor_fndecl_caf_stopped_images
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_stopped_images")), "WRR",
+ void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+ integer_type_node);
+
gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
void_type_node, 5, pvoid_type_node, integer_type_node,
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9c4715b..7bced25 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6228,13 +6228,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&se->pre, &post);
/* Transformational functions of derived types with allocatable
- components must have the result allocatable components copied. */
+ components must have the result allocatable components copied when the
+ argument is actually given. */
arg = expr->value.function.actual;
if (result && arg && expr->rank
- && expr->value.function.isym
- && expr->value.function.isym->transformational
- && arg->expr->ts.type == BT_DERIVED
- && arg->expr->ts.u.derived->attr.alloc_comp)
+ && expr->value.function.isym
+ && expr->value.function.isym->transformational
+ && arg->expr
+ && arg->expr->ts.type == BT_DERIVED
+ && arg->expr->ts.u.derived->attr.alloc_comp)
{
tree tmp2;
/* Copy the allocatable components. We have to use a
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 14781ac..b7524bc 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2388,6 +2388,42 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
}
+/* Convert a call to image_status. */
+
+static void
+conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
+{
+ unsigned int num_args;
+ tree *args, tmp;
+
+ num_args = gfc_intrinsic_argument_list_length (expr);
+ args = XALLOCAVEC (tree, num_args);
+ gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+ /* In args[0] the number of the image the status is desired for has to be
+ given. */
+
+ if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ {
+ tree arg;
+ arg = gfc_evaluate_now (args[0], &se->pre);
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ fold_convert (integer_type_node, arg),
+ integer_one_node);
+ tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+ tmp, integer_zero_node,
+ build_int_cst (integer_type_node,
+ GFC_STAT_STOPPED_IMAGE));
+ }
+ else if (flag_coarray == GFC_FCOARRAY_LIB)
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+ args[0], build_int_cst (integer_type_node, -1));
+ else
+ gcc_unreachable ();
+
+ se->expr = tmp;
+}
+
+
static void
trans_image_index (gfc_se * se, gfc_expr *expr)
{
@@ -9108,6 +9144,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
trans_image_index (se, expr);
break;
+ case GFC_ISYM_IMAGE_STATUS:
+ conv_intrinsic_image_status (se, expr);
+ break;
+
case GFC_ISYM_NUM_IMAGES:
trans_num_images (se, expr);
break;
@@ -9458,10 +9498,12 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
/* Ignore absent optional parameters. */
return 1;
- case GFC_ISYM_RESHAPE:
case GFC_ISYM_CSHIFT:
case GFC_ISYM_EOSHIFT:
+ case GFC_ISYM_FAILED_IMAGES:
+ case GFC_ISYM_STOPPED_IMAGES:
case GFC_ISYM_PACK:
+ case GFC_ISYM_RESHAPE:
case GFC_ISYM_UNPACK:
/* Pass absent optional parameters. */
return 2;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 773ca70..98687c8 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,24 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
return gfc_finish_block (&se.pre);
}
+/* Translate the FAIL IMAGE statement. */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+ if (flag_coarray == GFC_FCOARRAY_LIB)
+ return build_call_expr_loc (input_location,
+ gfor_fndecl_caf_fail_image, 1,
+ build_int_cst (pchar_type_node, 0));
+ else
+ {
+ const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+ gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+ tree tmp = gfc_get_symbol_decl (exsym);
+ return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+ }
+}
+
tree
gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index cc367bf..0a39e26 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select_type (gfc_code *);
tree gfc_trans_sync (gfc_code *, gfc_exec_op);
tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op);
tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op);
+tree gfc_trans_fail_image (gfc_code *);
tree gfc_trans_forall (gfc_code *);
tree gfc_trans_where (gfc_code *);
tree gfc_trans_allocate (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 82ed19a..e25ccaa 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1953,6 +1953,10 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_event_post_wait (code, code->op);
break;
+ case EXEC_FAIL_IMAGE:
+ res = gfc_trans_fail_image (code);
+ break;
+
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c72fd35..d02f347 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -833,6 +833,10 @@ extern GTY(()) tree gfor_fndecl_caf_unlock;
extern GTY(()) tree gfor_fndecl_caf_event_post;
extern GTY(()) tree gfor_fndecl_caf_event_wait;
extern GTY(()) tree gfor_fndecl_caf_event_query;
+extern GTY(()) tree gfor_fndecl_caf_fail_image;
+extern GTY(()) tree gfor_fndecl_caf_failed_images;
+extern GTY(()) tree gfor_fndecl_caf_image_status;
+extern GTY(()) tree gfor_fndecl_caf_stopped_images;
extern GTY(()) tree gfor_fndecl_co_broadcast;
extern GTY(()) tree gfor_fndecl_co_max;
extern GTY(()) tree gfor_fndecl_co_min;
diff --git a/gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08 b/gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08
new file mode 100644
index 0000000..b1e1bbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+program fail_image_statement_1
+ implicit none
+
+ fail image ! OK
+ fail image (1) ! { dg-error "Syntax error in FAIL IMAGE statement at \\(1\\)" }
+
+end program fail_image_statement_1
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08 b/gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08
new file mode 100644
index 0000000..e482a60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08
@@ -0,0 +1,10 @@
+! { dg-do run }
+
+program fail_image_statement_2
+ implicit none
+
+ fail image ! OK
+ error stop "This statement should not be reached."
+
+end program fail_image_statement_2
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
new file mode 100644
index 0000000..4898dd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+program test_failed_images_1
+ implicit none
+
+ integer, allocatable :: fi(:)
+ real :: r
+ integer :: i
+
+ fi = failed_images() ! OK
+ fi = failed_images(TEAM=1) ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) not yet supported" }
+ fi = failed_images(KIND=1) ! OK
+ fi = failed_images(KIND=4) ! OK
+ fi = failed_images(KIND=0) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be positive" }
+ fi = failed_images(KIND=r) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be INTEGER" }
+ fi = failed_images(KIND=i) ! { dg-error "Constant expression required at \\\(1\\\)" }
+ fi = failed_images(KIND=42) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) shall specify a valid integer kind" }
+
+end program test_failed_images_1
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
new file mode 100644
index 0000000..ca5fe40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+program test_failed_images_2
+ implicit none
+
+ integer, allocatable :: fi(:)
+ integer(kind=1), allocatable :: sfi(:)
+
+ fi = failed_images()
+ if (size(fi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=1)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=8)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+
+end program test_failed_images_2
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
new file mode 100644
index 0000000..098a2bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
@@ -0,0 +1,26 @@
+! { dg-do compile }
+
+program test_image_status_1
+ implicit none
+
+ integer :: isv
+ integer(kind=1) :: k1
+ integer(kind=2) :: k2
+ integer(kind=4) :: k4
+ integer(kind=8) :: k8
+
+ isv = image_status(1) ! Ok
+ isv = image_status(-1) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be positive" }
+ isv = image_status(0) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be positive" }
+ isv = image_status(.true.) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be INTEGER" }
+ isv = image_status([1,2,3]) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be a scalar" }
+ isv = image_status(k1) ! Ok
+ isv = image_status(k2) ! Ok
+ isv = image_status(k4) ! Ok
+ isv = image_status(k8) ! Ok
+ isv = image_status(1, team=1) ! { dg-error "'team' argument of 'image_status' intrinsic at \\(1\\) not yet supported" }
+ isv = image_status() ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
+ isv = image_status(team=1) ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
+
+end program test_image_status_1
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
new file mode 100644
index 0000000..fb49289
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
@@ -0,0 +1,12 @@
+! { dg-do run }
+
+program test_image_status_2
+ use iso_fortran_env , only : STAT_STOPPED_IMAGE
+ implicit none
+
+ if (image_status(1) /= 0) error stop "Image 1 should report OK."
+ if (image_status(2) /= STAT_STOPPED_IMAGE) error stop "Image 2 should be stopped."
+ if (image_status(3) /= STAT_STOPPED_IMAGE) error stop "Image 3 should be stopped."
+
+end program test_image_status_2
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
new file mode 100644
index 0000000..403de58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+program test_stopped_images_1
+ implicit none
+
+ integer, allocatable :: gi(:)
+ real :: r
+ integer :: i
+
+ gi = stopped_images() ! OK
+ gi = stopped_images(TEAM=1) ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) not yet supported" }
+ gi = stopped_images(KIND=1) ! OK
+ gi = stopped_images(KIND=4) ! OK
+ gi = stopped_images(KIND=0) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be positive" }
+ gi = stopped_images(KIND=r) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be INTEGER" }
+ gi = stopped_images(KIND=i) ! { dg-error "Constant expression required at \\\(1\\\)" }
+ gi = stopped_images(KIND=42) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) shall specify a valid integer kind" }
+
+end program test_stopped_images_1
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
new file mode 100644
index 0000000..0bf4a81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+program test_stopped_images_2
+ implicit none
+
+ integer, allocatable :: si(:)
+ integer(kind=1), allocatable :: ssi(:)
+
+ si = stopped_images()
+ if (size(si) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=1)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=8)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+
+end program test_stopped_images_2
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_fail_st.f90 b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
new file mode 100644
index 0000000..d4eb8e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program fail_statement
+ implicit none
+
+ integer :: me,np,stat
+
+ me = this_image()
+ np = num_images()
+ stat = 0
+
+ if(me == 1) fail image
+
+ sync all(stat=stat)
+
+ if(stat /= 0) write(*,*) 'Image failed during sync'
+
+end program fail_statement
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_fail_image \\\(0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08
new file mode 100644
index 0000000..82387ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fcoarray=lib -lcaf_single" }
+
+program test_failed_images_1
+ implicit none
+
+ integer :: me,np,stat
+ character(len=1) :: c
+ integer, allocatable :: fi(:)
+ integer(kind=1), allocatable :: sfi(:)
+
+ fi = failed_images()
+ if (size(fi) > 0) error stop "failed_images result shall be empty array"
+ if (allocated(fi)) error stop "failed_images result shall not be allocated"
+
+ sfi = failed_images(KIND=1)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+ if (allocated(sfi)) error stop "failed_images result shall not be allocated"
+
+ sfi = failed_images(KIND=8)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+! The implicit type conversion in the assignment above allocates an array.
+! if (allocated(sfi)) error stop "failed_images result shall not be allocated"
+
+end program test_failed_images_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status_1.f08 b/gcc/testsuite/gfortran.dg/coarray_image_status_1.f08
new file mode 100644
index 0000000..1062c60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status_1.f08
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single -fdump-tree-original" }
+
+program test_image_status_1
+ use iso_fortran_env , only : STAT_STOPPED_IMAGE
+ implicit none
+
+ if (image_status(1) /= 0) error stop "image_status(1) should not fail"
+ if (image_status(42) /= STAT_STOPPED_IMAGE) error stop "image_status(42) should report stopped image"
+
+end program test_image_status_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(1, .+\\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(42, .+\\\)" 1 "original" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08
new file mode 100644
index 0000000..36f86ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fcoarray=lib -lcaf_single" }
+
+program test_stopped_images_1
+ implicit none
+
+ integer :: me,np,stat
+ character(len=1) :: c
+ integer, allocatable :: si(:)
+ integer(kind=1), allocatable :: ssi(:)
+
+ si = stopped_images()
+ if (size(si) > 0) error stop "stopped_images result shall be empty array at 1"
+ if (allocated(si)) error stop "stopped_images result shall not be allocated at 1"
+
+ ssi = stopped_images(KIND=1)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array at 2"
+ if (allocated(ssi)) error stop "stopped_images result shall not be allocated at 2"
+
+ ssi = stopped_images(KIND=8)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array at 3"
+! The implicit type conversion in the assignment above allocates an array.
+! if (allocated(ssi)) error stop "stopped_images result shall not be allocated at 3"
+
+end program test_stopped_images_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 5c39202..2472646 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -41,14 +41,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#define likely(x) __builtin_expect(!!(x), 1)
#define unlikely(x) __builtin_expect(!!(x), 0)
#endif
+#endif
/* Definitions of the Fortran 2008 standard; need to kept in sync with
- ISO_FORTRAN_ENV, cf. libgfortran.h. */
-#define STAT_UNLOCKED 0
-#define STAT_LOCKED 1
-#define STAT_LOCKED_OTHER_IMAGE 2
-#define STAT_STOPPED_IMAGE 6000
-#endif
+ ISO_FORTRAN_ENV, cf. gcc/fortran/libgfortran.h. */
+typedef enum
+{
+ CAF_STAT_UNLOCKED = 0,
+ CAF_STAT_LOCKED,
+ CAF_STAT_LOCKED_OTHER_IMAGE,
+ CAF_STAT_STOPPED_IMAGE = 6000,
+ CAF_STAT_FAILED_IMAGE = 6001
+}
+caf_stat_codes_t;
+
/* Describes what type of array we are registerring. Keep in sync with
gcc/fortran/trans.h. */
@@ -74,6 +80,7 @@ typedef enum caf_deregister_t {
caf_deregister_t;
typedef void* caf_token_t;
+typedef void * caf_team_t;
typedef gfc_array_void gfc_descriptor_t;
/* Linked list of static coarrays registered. */
@@ -198,6 +205,7 @@ void _gfortran_caf_stop_str (const char *, int32_t)
void _gfortran_caf_error_stop_str (const char *, int32_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
+void _gfortran_caf_fail_image (void) __attribute__ ((noreturn));
void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
@@ -243,6 +251,13 @@ 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 *);
+void _gfortran_caf_failed_images (gfc_descriptor_t *,
+ caf_team_t * __attribute__ ((unused)), int *);
+int _gfortran_caf_image_status (int, caf_team_t * __attribute__ ((unused)));
+void _gfortran_caf_stopped_images (gfc_descriptor_t *,
+ caf_team_t * __attribute__ ((unused)),
+ int *);
+
int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
#endif /* LIBCAF_H */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 8d3bcbf..bf1a229 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -264,6 +264,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
*stat = 0;
}
+
void
_gfortran_caf_stop_numeric(int32_t stop_code)
{
@@ -271,6 +272,7 @@ _gfortran_caf_stop_numeric(int32_t stop_code)
exit (0);
}
+
void
_gfortran_caf_stop_str(const char *string, int32_t len)
{
@@ -282,6 +284,7 @@ _gfortran_caf_stop_str(const char *string, int32_t len)
exit (0);
}
+
void
_gfortran_caf_error_stop_str (const char *string, int32_t len)
{
@@ -294,6 +297,74 @@ _gfortran_caf_error_stop_str (const char *string, int32_t len)
}
+/* Reported that the program terminated because of a fail image issued.
+ Because this is a single image library, nothing else than aborting the whole
+ program can be done. */
+
+void _gfortran_caf_fail_image (void)
+{
+ fputs ("IMAGE FAILED!\n", stderr);
+ exit (0);
+}
+
+
+/* Get the status of image IMAGE. Because being the single image library all
+ other images are reported to be stopped. */
+
+int _gfortran_caf_image_status (int image,
+ caf_team_t * team __attribute__ ((unused)))
+{
+ if (image == 1)
+ return 0;
+ else
+ return CAF_STAT_STOPPED_IMAGE;
+}
+
+
+/* Single image library. There can not be any failed images with only one
+ image. */
+
+void
+_gfortran_caf_failed_images (gfc_descriptor_t *array,
+ caf_team_t * team __attribute__ ((unused)),
+ int * kind)
+{
+ int local_kind = kind != NULL ? *kind : 4;
+
+ array->base_addr = NULL;
+ array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
+ | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+ /* Setting lower_bound higher then upper_bound is what the compiler does to
+ indicate an empty array. */
+ array->dim[0].lower_bound = 0;
+ array->dim[0]._ubound = -1;
+ array->dim[0]._stride = 1;
+ array->offset = 0;
+}
+
+
+/* With only one image available no other images can be stopped. Therefore
+ return an empty array. */
+
+void
+_gfortran_caf_stopped_images (gfc_descriptor_t *array,
+ caf_team_t * team __attribute__ ((unused)),
+ int * kind)
+{
+ int local_kind = kind != NULL ? *kind : 4;
+
+ array->base_addr = NULL;
+ array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
+ | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+ /* Setting lower_bound higher then upper_bound is what the compiler does to
+ indicate an empty array. */
+ array->dim[0].lower_bound = 0;
+ array->dim[0]._ubound = -1;
+ array->dim[0]._stride = 1;
+ array->offset = 0;
+}
+
+
void
_gfortran_caf_error_stop (int32_t error)
{
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-04 17:59 [PATCH, Fortran, Coarray, v1] Add support for failed images Andre Vehreschild
@ 2017-03-04 19:52 ` Alessandro Fanfarillo
2017-03-04 20:25 ` Andre Vehreschild
2017-03-04 23:06 ` Jerry DeLisle
1 sibling, 1 reply; 9+ messages in thread
From: Alessandro Fanfarillo @ 2017-03-04 19:52 UTC (permalink / raw)
To: Andre Vehreschild
Cc: GCC-Patches-ML, GCC-Fortran-ML, Alessandro Fanfarillo, Damian Rouson
Hi Andre,
thanks for your work on the patch. I agree with you about exit(0)
statement in libcaf_single.
Could you please add my name and contact (Alessandro Fanfarillo
<fanfarillo.gcc@gmail.com>) below yours in the changelog?
Thanks,
Alessandro
2017-03-04 10:58 GMT-07:00 Andre Vehreschild <vehre@gmx.de>:
> Hi all,
>
> attached patch polishes the one begun by Alessandro. It adds documentation and
> fixes the style issues. Furthermore did I try to interpret the standard
> according to the FAIL IMAGE statement. IMHO should it just quit the executable
> without any error code. The caf_single library emits "FAIL IMAGE" to stderr,
> while in coarray=single mode it just quits. What do you think?
>
> Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be later).
>
> Gruß,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-04 19:52 ` Alessandro Fanfarillo
@ 2017-03-04 20:25 ` Andre Vehreschild
0 siblings, 0 replies; 9+ messages in thread
From: Andre Vehreschild @ 2017-03-04 20:25 UTC (permalink / raw)
To: Alessandro Fanfarillo
Cc: GCC-Patches-ML, GCC-Fortran-ML, Alessandro Fanfarillo, Damian Rouson
Hi Alessandro,
Yes of course. I planned to. Sorry that I forgot.
- Andre
Am 4. März 2017 20:51:58 MEZ schrieb Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>Hi Andre,
>thanks for your work on the patch. I agree with you about exit(0)
>statement in libcaf_single.
>Could you please add my name and contact (Alessandro Fanfarillo
><fanfarillo.gcc@gmail.com>) below yours in the changelog?
>
>Thanks,
>Alessandro
>
>
>2017-03-04 10:58 GMT-07:00 Andre Vehreschild <vehre@gmx.de>:
>> Hi all,
>>
>> attached patch polishes the one begun by Alessandro. It adds
>documentation and
>> fixes the style issues. Furthermore did I try to interpret the
>standard
>> according to the FAIL IMAGE statement. IMHO should it just quit the
>executable
>> without any error code. The caf_single library emits "FAIL IMAGE" to
>stderr,
>> while in coarray=single mode it just quits. What do you think?
>>
>> Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be
>later).
>>
>> Gruß,
>> Andre
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 929 10 18 * vehre@gmx.de
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-04 17:59 [PATCH, Fortran, Coarray, v1] Add support for failed images Andre Vehreschild
2017-03-04 19:52 ` Alessandro Fanfarillo
@ 2017-03-04 23:06 ` Jerry DeLisle
2017-03-05 11:41 ` Andre Vehreschild
1 sibling, 1 reply; 9+ messages in thread
From: Jerry DeLisle @ 2017-03-04 23:06 UTC (permalink / raw)
To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML
Cc: Alessandro Fanfarillo, Damian Rouson
On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
> Hi all,
>
> attached patch polishes the one begun by Alessandro. It adds documentation and
> fixes the style issues. Furthermore did I try to interpret the standard
> according to the FAIL IMAGE statement. IMHO should it just quit the executable
> without any error code. The caf_single library emits "FAIL IMAGE" to stderr,
> while in coarray=single mode it just quits. What do you think?
>
> Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be later).
>
> Gruß,
> Andre
>
From my read:
"A failed image is usually associated with a hardware failure of the processor,
memory system, or interconnection network"
Since the FAIL IMAGE statement is intended to simulate such failure, I agree
with your interpretation as well, it just stops execution.
Yes OK for trunk now.
Jerry
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-04 23:06 ` Jerry DeLisle
@ 2017-03-05 11:41 ` Andre Vehreschild
2017-03-08 22:58 ` Christophe Lyon
0 siblings, 1 reply; 9+ messages in thread
From: Andre Vehreschild @ 2017-03-05 11:41 UTC (permalink / raw)
To: Jerry DeLisle
Cc: GCC-Patches-ML, GCC-Fortran-ML, Alessandro Fanfarillo, Damian Rouson
[-- Attachment #1: Type: text/plain, Size: 1216 bytes --]
Hi Jerry,
thanks for seconding my read of the standard and reviewing so quickly.
Committed as r245900.
Regards,
Andre
On Sat, 4 Mar 2017 15:06:25 -0800
Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
> > Hi all,
> >
> > attached patch polishes the one begun by Alessandro. It adds documentation
> > and fixes the style issues. Furthermore did I try to interpret the standard
> > according to the FAIL IMAGE statement. IMHO should it just quit the
> > executable without any error code. The caf_single library emits "FAIL
> > IMAGE" to stderr, while in coarray=single mode it just quits. What do you
> > think?
> >
> > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be
> > later).
> >
> > Gruß,
> > Andre
> >
>
> From my read:
>
> "A failed image is usually associated with a hardware failure of the
> processor, memory system, or interconnection network"
>
> Since the FAIL IMAGE statement is intended to simulate such failure, I agree
> with your interpretation as well, it just stops execution.
>
> Yes OK for trunk now.
>
> Jerry
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 52923 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 245899)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,51 @@
+2017-03-05 Andre Vehreschild <vehre@gcc.gnu.org>,
+ Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+ * check.c (positive_check): Add new function checking constant for
+ being greater then zero.
+ (gfc_check_image_status): Add checking of image_status arguments.
+ (gfc_check_failed_or_stopped_images): Same but for failed_- and
+ stopped_images function.
+ * dump-parse-tree.c (show_code_node): Added output of FAIL IMAGE.
+ * gfortran.h (enum gfc_statement): Added FAIL_IMAGE_ST.
+ (enum gfc_isym_id): Added new intrinsic symbols.
+ (enum gfc_exec_op): Added EXEC_FAIL_IMAGE.
+ * gfortran.texi: Added description for the new API functions. Updated
+ coverage of gfortran of TS18508.
+ * intrinsic.c (add_functions): Added symbols to resolve new intrinsic
+ functions.
+ * intrinsic.h: Added prototypes.
+ * iresolve.c (gfc_resolve_failed_images): Resolve the failed_images
+ intrinsic.
+ (gfc_resolve_image_status): Same for image_status.
+ (gfc_resolve_stopped_images): Same for stopped_images.
+ * libgfortran.h: Added prototypes.
+ * match.c (gfc_match_if): Added matching of FAIL IMAGE statement.
+ (gfc_match_fail_image): Match a FAIL IMAGE statement.
+ * match.h: Added prototype.
+ * parse.c (decode_statement): Added matching for FAIL IMAGE.
+ (next_statement): Same.
+ (gfc_ascii_statement): Same.
+ * resolve.c: Same.
+ * simplify.c (gfc_simplify_failed_or_stopped_images): For COARRAY=
+ single a constant result can be returne.d
+ (gfc_simplify_image_status): For COARRAY=single the result is constant.
+ * st.c (gfc_free_statement): Added FAIL_IMAGE handling.
+ * trans-decl.c (gfc_build_builtin_function_decls): Added decls of the
+ new intrinsics.
+ * trans-expr.c (gfc_conv_procedure_call): This is first time all
+ arguments of a function are optional, which is now handled here
+ correctly.
+ * trans-intrinsic.c (conv_intrinsic_image_status): Translate
+ image_status.
+ (gfc_conv_intrinsic_function): Add support for image_status.
+ (gfc_is_intrinsic_libcall): Add support for the remaining new
+ intrinsics.
+ * trans-stmt.c (gfc_trans_fail_image): Trans a fail image.
+ * trans-stmt.h: Add the prototype for the above.
+ * trans.c (trans_code): Dispatch for fail_image.
+ * trans.h: Add the trees for the new intrinsics.
+
2017-03-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/79841
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (Revision 245899)
+++ gcc/fortran/check.c (Arbeitskopie)
@@ -295,6 +295,29 @@
}
+/* If expr is a constant, then check to ensure that it is greater than zero. */
+
+static bool
+positive_check (int n, gfc_expr *expr)
+{
+ int i;
+
+ if (expr->expr_type == EXPR_CONSTANT)
+ {
+ gfc_extract_int (expr, &i);
+ if (i <= 0)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be positive",
+ gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+ &expr->where);
+ return false;
+ }
+ }
+
+ return true;
+}
+
+
/* If expr2 is constant, then check that the value is less than
(less than or equal to, if 'or_equal' is true) bit_size(expr1). */
@@ -1138,6 +1161,60 @@
bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+ /* IMAGE has to be a positive, scalar integer. */
+ if (!type_check (image, 0, BT_INTEGER) || !scalar_check (image, 0)
+ || !positive_check (0, image))
+ return false;
+
+ if (team)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+ gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+ &team->where);
+ return false;
+ }
+ return true;
+}
+
+
+bool
+gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
+{
+ if (team)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+ gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+ &team->where);
+ return false;
+ }
+
+ if (kind)
+ {
+ int k;
+
+ if (!type_check (kind, 1, BT_INTEGER) || !scalar_check (kind, 1)
+ || !positive_check (1, kind))
+ return false;
+
+ /* Get the kind, reporting error on non-constant or overflow. */
+ gfc_current_locus = kind->where;
+ if (gfc_extract_int (kind, &k, 1))
+ return false;
+ if (gfc_validate_kind (BT_INTEGER, k, true) == -1)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L shall specify a "
+ "valid integer kind", gfc_current_intrinsic_arg[1]->name,
+ gfc_current_intrinsic, &kind->where);
+ return false;
+ }
+ }
+ return true;
+}
+
+
+bool
gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
gfc_expr *new_val, gfc_expr *stat)
{
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c (Revision 245899)
+++ gcc/fortran/dump-parse-tree.c (Arbeitskopie)
@@ -1818,6 +1818,10 @@
break;
+ case EXEC_FAIL_IMAGE:
+ fputs ("FAIL IMAGE ", dumpfile);
+ break;
+
case EXEC_SYNC_ALL:
fputs ("SYNC ALL ", dumpfile);
if (c->expr2 != NULL)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 245899)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -263,7 +263,7 @@
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
- ST_EVENT_WAIT,ST_NONE
+ ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -429,6 +429,7 @@
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
GFC_ISYM_EXTENDS_TYPE_OF,
+ GFC_ISYM_FAILED_IMAGES,
GFC_ISYM_FDATE,
GFC_ISYM_FE_RUNTIME_ERROR,
GFC_ISYM_FGET,
@@ -472,6 +473,7 @@
GFC_ISYM_IEOR,
GFC_ISYM_IERRNO,
GFC_ISYM_IMAGE_INDEX,
+ GFC_ISYM_IMAGE_STATUS,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_INT2,
@@ -585,6 +587,7 @@
GFC_ISYM_SRAND,
GFC_ISYM_SR_KIND,
GFC_ISYM_STAT,
+ GFC_ISYM_STOPPED_IMAGES,
GFC_ISYM_STORAGE_SIZE,
GFC_ISYM_STRIDE,
GFC_ISYM_SUM,
@@ -2457,7 +2460,7 @@
EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
- EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT,
+ EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE,
EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (Revision 245899)
+++ gcc/fortran/gfortran.texi (Arbeitskopie)
@@ -1125,7 +1125,7 @@
@item GNU Fortran's implementation for variables with @code{ASYNCHRONOUS}
attribute is compatible with TS 29113.
-@item Assumed types (@code{TYPE(*)}.
+@item Assumed types (@code{TYPE(*)}).
@item Assumed-rank (@code{DIMENSION(..)}). However, the array descriptor
of the TS is not yet supported.
@@ -1147,6 +1147,10 @@
polymorphic components.
@item Events (@code{EVENT POST}, @code{EVENT WAIT}, @code{EVENT_QUERY})
+
+@item Failed images (@code{FAIL IMAGE}, @code{IMAGE_STATUS},
+@code{FAILED_IMAGES}, @code{STOPPED_IMAGES})
+
@end itemize
@@ -3873,6 +3877,7 @@
* caf_register_t::
* caf_deregister_t::
* caf_reference_t::
+* caf_team_t::
@end menu
@node caf_token_t
@@ -4035,7 +4040,12 @@
At the moment @code{CAF_ARR_REF_VECTOR} is not implemented in the front end for
descriptor-less arrays. The library caf_single has untested support for it.
+@node caf_team_t
+@subsection @code{caf_team_t}
+Opaque pointer to represent a team-handle. This type is a stand-in for the
+future implementation of teams. It is about to change without further notice.
+
@node Function ABI Documentation
@section Function ABI Documentation
@@ -4044,6 +4054,9 @@
* _gfortran_caf_finish:: Finalization function
* _gfortran_caf_this_image:: Querying the image number
* _gfortran_caf_num_images:: Querying the maximal number of images
+* _gfortran_caf_image_status :: Query the status of an image
+* _gfortran_caf_failed_images :: Get an array of the indexes of the failed images
+* _gfortran_caf_stopped_images :: Get an array of the indexes of the stopped images
* _gfortran_caf_register:: Registering coarrays
* _gfortran_caf_deregister:: Deregistering coarrays
* _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated
@@ -4063,6 +4076,7 @@
* _gfortran_caf_sync_memory:: Wait for completion of segment-memory operations
* _gfortran_caf_error_stop:: Error termination with exit code
* _gfortran_caf_error_stop_str:: Error termination with string
+* _gfortran_caf_fail_image :: Mark the image failed and end its execution
* _gfortran_caf_atomic_define:: Atomic variable assignment
* _gfortran_caf_atomic_ref:: Atomic variable reference
* _gfortran_caf_atomic_cas:: Atomic compare and swap
@@ -4182,6 +4196,90 @@
@end table
+@node _gfortran_caf_image_status
+@subsection @code{_gfortran_caf_image_status} --- Query the status of an image
+@cindex Coarray, _gfortran_caf_image_status
+
+@table @asis
+@item @emph{Description}:
+Get the status of the image given by the id @var{image} of the team given by
+@var{team}. Valid results are zero, for image is ok, @code{STAT_STOPPED_IMAGE}
+from the ISO_FORTRAN_ENV module to indicate that the image has been stopped and
+@code{STAT_FAILED_IMAGE} also from ISO_FORTRAN_ENV to indicate that the image
+has executed a @code{FAIL IMAGE} statement.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_image_status (int image, caf_team_t * team)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{image} @tab the positive scalar id of the image in the current TEAM.
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_failed_images
+@subsection @code{_gfortran_caf_failed_images} --- Get an array of the indexes of the failed images
+@cindex Coarray, _gfortran_caf_failed_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have failed. The
+array is sorted ascendingly. When @var{team} is not provided the current team
+is to be used. When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind. The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_failed_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_stopped_images
+@subsection @code{_gfortran_caf_stopped_images} --- Get an array of the indexes of the stopped images
+@cindex Coarray, _gfortran_caf_stopped_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have stopped. The
+array is sorted ascendingly. When @var{team} is not provided the current team
+is to be used. When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind. The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_stopped_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508. Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
@node _gfortran_caf_register
@subsection @code{_gfortran_caf_register} --- Registering coarrays
@cindex Coarray, _gfortran_caf_register
@@ -4993,6 +5091,24 @@
+@node _gfortran_caf_fail_image
+@subsection @code{_gfortran_caf_fail_image} --- Mark the image failed and end its execution
+@cindex Coarray, _gfortran_caf_fail_image
+
+@table @asis
+@item @emph{Description}:
+Invoked for an @code{FAIL IMAGE} statement. The function should terminate the
+current image.
+
+@item @emph{Syntax}:
+@code{void _gfortran_caf_fail_image ()}
+
+@item @emph{NOTES}
+This function follows TS18508.
+@end table
+
+
+
@node _gfortran_caf_atomic_define
@subsection @code{_gfortran_caf_atomic_define} --- Atomic variable assignment
@cindex Coarray, _gfortran_caf_atomic_define
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (Revision 245899)
+++ gcc/fortran/intrinsic.c (Arbeitskopie)
@@ -1840,6 +1840,13 @@
a, BT_UNKNOWN, 0, REQUIRED,
mo, BT_UNKNOWN, 0, REQUIRED);
+ add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL,
+ ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+ gfc_check_failed_or_stopped_images,
+ gfc_simplify_failed_or_stopped_images,
+ gfc_resolve_failed_images, "team", BT_VOID, di, OPTIONAL,
+ "kind", BT_INTEGER, di, OPTIONAL);
+
add_sym_0 ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
@@ -2081,6 +2088,11 @@
gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
+ add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
+ BT_INTEGER, di, GFC_STD_F2008_TS, gfc_check_image_status,
+ gfc_simplify_image_status, gfc_resolve_image_status, "image",
+ BT_INTEGER, di, REQUIRED, "team", BT_VOID, di, OPTIONAL);
+
/* The resolution function for INDEX is called gfc_resolve_index_func
because the name gfc_resolve_index is already used in resolve.c. */
add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
@@ -2989,6 +3001,13 @@
make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
+ add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
+ ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+ gfc_check_failed_or_stopped_images,
+ gfc_simplify_failed_or_stopped_images,
+ gfc_resolve_stopped_images, "team", BT_VOID, di, OPTIONAL,
+ "kind", BT_INTEGER, di, OPTIONAL);
+
add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_storage_size, gfc_simplify_storage_size,
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h (Revision 245899)
+++ gcc/fortran/intrinsic.h (Arbeitskopie)
@@ -71,6 +71,7 @@
bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_dtime_etime (gfc_expr *);
bool gfc_check_event_query (gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_failed_or_stopped_images (gfc_expr *, gfc_expr *);
bool gfc_check_fgetputc (gfc_expr *, gfc_expr *);
bool gfc_check_fgetput (gfc_expr *);
bool gfc_check_float (gfc_expr *);
@@ -92,6 +93,7 @@
bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
bool gfc_check_idnint (gfc_expr *);
bool gfc_check_ieor (gfc_expr *, gfc_expr *);
+bool gfc_check_image_status (gfc_expr *, gfc_expr *);
bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_int (gfc_expr *, gfc_expr *);
bool gfc_check_intconv (gfc_expr *);
@@ -292,6 +294,7 @@
gfc_expr *gfc_simplify_exp (gfc_expr *);
gfc_expr *gfc_simplify_exponent (gfc_expr *);
gfc_expr *gfc_simplify_extends_type_of (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_failed_or_stopped_images (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_float (gfc_expr *);
gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_fraction (gfc_expr *);
@@ -308,6 +311,7 @@
gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_int2 (gfc_expr *);
@@ -473,6 +477,7 @@
void gfc_resolve_exp (gfc_expr *, gfc_expr *);
void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_failed_images (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_fdate (gfc_expr *);
void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
@@ -496,6 +501,7 @@
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
void gfc_resolve_ierrno (gfc_expr *);
@@ -571,12 +577,13 @@
void gfc_resolve_sin (gfc_expr *, gfc_expr *);
void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_stopped_images (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a, gfc_expr *kind);
+void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_srand (gfc_code *);
void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (Revision 245899)
+++ gcc/fortran/iresolve.c (Arbeitskopie)
@@ -2830,7 +2830,39 @@
}
+/* Resolve failed_images (team, kind). */
+
void
+gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ static char failed_images[] = "_gfortran_caf_failed_images";
+ f->rank = 1;
+ f->ts.type = BT_INTEGER;
+ if (kind == NULL)
+ f->ts.kind = gfc_default_integer_kind;
+ else
+ gfc_extract_int (kind, &f->ts.kind);
+ f->value.function.name = failed_images;
+}
+
+
+/* Resolve image_status (image, team). */
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
+ gfc_expr *team ATTRIBUTE_UNUSED)
+{
+ static char image_status[] = "_gfortran_caf_image_status";
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = image_status;
+}
+
+
+/* Resolve image_index (...). */
+
+void
gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
gfc_expr *sub ATTRIBUTE_UNUSED)
{
@@ -2841,7 +2873,24 @@
}
+/* Resolve stopped_images (team, kind). */
+
void
+gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ static char stopped_images[] = "_gfortran_caf_stopped_images";
+ f->rank = 1;
+ f->ts.type = BT_INTEGER;
+ if (kind == NULL)
+ f->ts.kind = gfc_default_integer_kind;
+ else
+ gfc_extract_int (kind, &f->ts.kind);
+ f->value.function.name = stopped_images;
+}
+
+
+void
gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *distance ATTRIBUTE_UNUSED)
{
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (Revision 245899)
+++ gcc/fortran/libgfortran.h (Arbeitskopie)
@@ -117,7 +117,7 @@
}
libgfortran_error_codes;
-/* Must kept in sync with libgfortrancaf.h. */
+/* Must kept in sync with libgfortran/caf/libcaf.h. */
typedef enum
{
GFC_STAT_UNLOCKED = 0,
@@ -124,7 +124,7 @@
GFC_STAT_LOCKED,
GFC_STAT_LOCKED_OTHER_IMAGE,
GFC_STAT_STOPPED_IMAGE = 6000, /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */
- GFC_STAT_FAILED_IMAGE
+ GFC_STAT_FAILED_IMAGE = 6001
}
libgfortran_stat_codes;
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (Revision 245899)
+++ gcc/fortran/match.c (Arbeitskopie)
@@ -1601,6 +1601,7 @@
match ("event post", gfc_match_event_post, ST_EVENT_POST)
match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
match ("exit", gfc_match_exit, ST_EXIT)
+ match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
@@ -3265,6 +3266,28 @@
}
+/* Match a FAIL IMAGE statement. */
+
+match
+gfc_match_fail_image (void)
+{
+ if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+ return MATCH_ERROR;
+
+ if (gfc_match_char ('(') == MATCH_YES)
+ goto syntax;
+
+ new_st.op = EXEC_FAIL_IMAGE;
+
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (ST_FAIL_IMAGE);
+
+ return MATCH_ERROR;
+}
+
+
/* Match LOCK/UNLOCK statement. Syntax:
LOCK ( lock-variable [ , lock-stat-list ] )
UNLOCK ( lock-variable [ , sync-stat-list ] )
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h (Revision 245899)
+++ gcc/fortran/match.h (Arbeitskopie)
@@ -73,6 +73,7 @@
match gfc_match_event_post (void);
match gfc_match_event_wait (void);
match gfc_match_critical (void);
+match gfc_match_fail_image (void);
match gfc_match_block (void);
match gfc_match_associate (void);
match gfc_match_do (void);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (Revision 245899)
+++ gcc/fortran/parse.c (Arbeitskopie)
@@ -488,6 +488,7 @@
break;
case 'f':
+ match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
match ("final", gfc_match_final_decl, ST_FINAL);
match ("flush", gfc_match_flush, ST_FLUSH);
match ("format", gfc_match_format, ST_FORMAT);
@@ -1499,7 +1500,7 @@
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
case ST_ERROR_STOP: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
- case ST_EVENT_POST: case ST_EVENT_WAIT: \
+ case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
@@ -1827,6 +1828,9 @@
case ST_EVENT_WAIT:
p = "EVENT WAIT";
break;
+ case ST_FAIL_IMAGE:
+ p = "FAIL IMAGE";
+ break;
case ST_END_ASSOCIATE:
p = "END ASSOCIATE";
break;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 245899)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -10883,6 +10883,9 @@
resolve_lock_unlock_event (code);
break;
+ case EXEC_FAIL_IMAGE:
+ break;
+
case EXEC_ENTRY:
/* Keep track of which entry we are up to. */
current_entry_id = code->ext.entry->id;
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (Revision 245899)
+++ gcc/fortran/simplify.c (Arbeitskopie)
@@ -2466,6 +2466,37 @@
gfc_expr *
+gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ if (flag_coarray == GFC_FCOARRAY_NONE)
+ {
+ gfc_current_locus = *gfc_current_intrinsic_where;
+ gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+ return &gfc_bad_expr;
+ }
+
+ if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ {
+ gfc_expr *result;
+ int actual_kind;
+ if (kind)
+ gfc_extract_int (kind, &actual_kind);
+ else
+ actual_kind = gfc_default_integer_kind;
+
+ result = gfc_get_array_expr (BT_INTEGER, actual_kind, &gfc_current_locus);
+ result->rank = 1;
+ return result;
+ }
+
+ /* For fcoarray = lib no simplification is possible, because it is not known
+ what images failed or are stopped at compile time. */
+ return NULL;
+}
+
+
+gfc_expr *
gfc_simplify_float (gfc_expr *a)
{
gfc_expr *result;
@@ -6763,7 +6794,37 @@
return result;
}
+gfc_expr *
+gfc_simplify_image_status (gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+ if (flag_coarray == GFC_FCOARRAY_NONE)
+ {
+ gfc_current_locus = *gfc_current_intrinsic_where;
+ gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+ return &gfc_bad_expr;
+ }
+ /* Simplification is possible for fcoarray = single only. For all other modes
+ the result depends on runtime conditions. */
+ if (flag_coarray != GFC_FCOARRAY_SINGLE)
+ return NULL;
+
+ if (gfc_is_constant_expr (image))
+ {
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+ &image->where);
+ if (mpz_get_si (image->value.integer) == 1)
+ mpz_set_si (result->value.integer, 0);
+ else
+ mpz_set_si (result->value.integer, GFC_STAT_STOPPED_IMAGE);
+ return result;
+ }
+ else
+ return NULL;
+}
+
+
gfc_expr *
gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim,
gfc_expr *distance ATTRIBUTE_UNUSED)
Index: gcc/fortran/st.c
===================================================================
--- gcc/fortran/st.c (Revision 245899)
+++ gcc/fortran/st.c (Arbeitskopie)
@@ -120,6 +120,7 @@
case EXEC_UNLOCK:
case EXEC_EVENT_POST:
case EXEC_EVENT_WAIT:
+ case EXEC_FAIL_IMAGE:
break;
case EXEC_BLOCK:
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 245899)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -153,6 +153,10 @@
tree gfor_fndecl_caf_event_post;
tree gfor_fndecl_caf_event_wait;
tree gfor_fndecl_caf_event_query;
+tree gfor_fndecl_caf_fail_image;
+tree gfor_fndecl_caf_failed_images;
+tree gfor_fndecl_caf_image_status;
+tree gfor_fndecl_caf_stopped_images;
tree gfor_fndecl_co_broadcast;
tree gfor_fndecl_co_max;
tree gfor_fndecl_co_min;
@@ -3732,6 +3736,28 @@
void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
pint_type, pint_type);
+ gfor_fndecl_caf_fail_image = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_fail_image")), void_type_node, 0);
+ /* CAF's FAIL doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image) = 1;
+
+ gfor_fndecl_caf_failed_images
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_failed_images")), "WRR",
+ void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+ integer_type_node);
+
+ gfor_fndecl_caf_image_status
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_image_status")), "RR",
+ integer_type_node, 2, integer_type_node, ppvoid_type_node);
+
+ gfor_fndecl_caf_stopped_images
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_stopped_images")), "WRR",
+ void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+ integer_type_node);
+
gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
void_type_node, 5, pvoid_type_node, integer_type_node,
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 245899)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -6228,13 +6228,15 @@
gfc_add_block_to_block (&se->pre, &post);
/* Transformational functions of derived types with allocatable
- components must have the result allocatable components copied. */
+ components must have the result allocatable components copied when the
+ argument is actually given. */
arg = expr->value.function.actual;
if (result && arg && expr->rank
- && expr->value.function.isym
- && expr->value.function.isym->transformational
- && arg->expr->ts.type == BT_DERIVED
- && arg->expr->ts.u.derived->attr.alloc_comp)
+ && expr->value.function.isym
+ && expr->value.function.isym->transformational
+ && arg->expr
+ && arg->expr->ts.type == BT_DERIVED
+ && arg->expr->ts.u.derived->attr.alloc_comp)
{
tree tmp2;
/* Copy the allocatable components. We have to use a
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 245899)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -2388,7 +2388,43 @@
}
+/* Convert a call to image_status. */
+
static void
+conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
+{
+ unsigned int num_args;
+ tree *args, tmp;
+
+ num_args = gfc_intrinsic_argument_list_length (expr);
+ args = XALLOCAVEC (tree, num_args);
+ gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+ /* In args[0] the number of the image the status is desired for has to be
+ given. */
+
+ if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ {
+ tree arg;
+ arg = gfc_evaluate_now (args[0], &se->pre);
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ fold_convert (integer_type_node, arg),
+ integer_one_node);
+ tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+ tmp, integer_zero_node,
+ build_int_cst (integer_type_node,
+ GFC_STAT_STOPPED_IMAGE));
+ }
+ else if (flag_coarray == GFC_FCOARRAY_LIB)
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+ args[0], build_int_cst (integer_type_node, -1));
+ else
+ gcc_unreachable ();
+
+ se->expr = tmp;
+}
+
+
+static void
trans_image_index (gfc_se * se, gfc_expr *expr)
{
tree num_images, cond, coindex, type, lbound, ubound, desc, subdesc,
@@ -9108,6 +9144,10 @@
trans_image_index (se, expr);
break;
+ case GFC_ISYM_IMAGE_STATUS:
+ conv_intrinsic_image_status (se, expr);
+ break;
+
case GFC_ISYM_NUM_IMAGES:
trans_num_images (se, expr);
break;
@@ -9458,10 +9498,12 @@
/* Ignore absent optional parameters. */
return 1;
- case GFC_ISYM_RESHAPE:
case GFC_ISYM_CSHIFT:
case GFC_ISYM_EOSHIFT:
+ case GFC_ISYM_FAILED_IMAGES:
+ case GFC_ISYM_STOPPED_IMAGES:
case GFC_ISYM_PACK:
+ case GFC_ISYM_RESHAPE:
case GFC_ISYM_UNPACK:
/* Pass absent optional parameters. */
return 2;
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 245899)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -674,8 +674,26 @@
return gfc_finish_block (&se.pre);
}
+/* Translate the FAIL IMAGE statement. */
tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+ if (flag_coarray == GFC_FCOARRAY_LIB)
+ return build_call_expr_loc (input_location,
+ gfor_fndecl_caf_fail_image, 1,
+ build_int_cst (pchar_type_node, 0));
+ else
+ {
+ const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+ gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+ tree tmp = gfc_get_symbol_decl (exsym);
+ return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+ }
+}
+
+
+tree
gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
{
gfc_se se, argse;
Index: gcc/fortran/trans-stmt.h
===================================================================
--- gcc/fortran/trans-stmt.h (Revision 245899)
+++ gcc/fortran/trans-stmt.h (Arbeitskopie)
@@ -56,6 +56,7 @@
tree gfc_trans_sync (gfc_code *, gfc_exec_op);
tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op);
tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op);
+tree gfc_trans_fail_image (gfc_code *);
tree gfc_trans_forall (gfc_code *);
tree gfc_trans_where (gfc_code *);
tree gfc_trans_allocate (gfc_code *);
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (Revision 245899)
+++ gcc/fortran/trans.c (Arbeitskopie)
@@ -1953,6 +1953,10 @@
res = gfc_trans_event_post_wait (code, code->op);
break;
+ case EXEC_FAIL_IMAGE:
+ res = gfc_trans_fail_image (code);
+ break;
+
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (Revision 245899)
+++ gcc/fortran/trans.h (Arbeitskopie)
@@ -833,6 +833,10 @@
extern GTY(()) tree gfor_fndecl_caf_event_post;
extern GTY(()) tree gfor_fndecl_caf_event_wait;
extern GTY(()) tree gfor_fndecl_caf_event_query;
+extern GTY(()) tree gfor_fndecl_caf_fail_image;
+extern GTY(()) tree gfor_fndecl_caf_failed_images;
+extern GTY(()) tree gfor_fndecl_caf_image_status;
+extern GTY(()) tree gfor_fndecl_caf_stopped_images;
extern GTY(()) tree gfor_fndecl_co_broadcast;
extern GTY(()) tree gfor_fndecl_co_max;
extern GTY(()) tree gfor_fndecl_co_min;
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 245899)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,19 @@
+2017-03-05 Andre Vehreschild <vehre@gcc.gnu.org>
+ Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+ * gfortran.dg/coarray/fail_image_1.f08: New test.
+ * gfortran.dg/coarray/fail_image_2.f08: New test.
+ * gfortran.dg/coarray/failed_images_1.f08: New test.
+ * gfortran.dg/coarray/failed_images_2.f08: New test.
+ * gfortran.dg/coarray/image_status_1.f08: New test.
+ * gfortran.dg/coarray/image_status_2.f08: New test.
+ * gfortran.dg/coarray/stopped_images_1.f08: New test.
+ * gfortran.dg/coarray/stopped_images_2.f08: New test.
+ * gfortran.dg/coarray_fail_st.f90: New test.
+ * gfortran.dg/coarray_failed_images_1.f08: New test.
+ * gfortran.dg/coarray_image_status_1.f08: New test.
+ * gfortran.dg/coarray_stopped_images_1.f08: New test.
+
2017-03-03 Marek Polacek <polacek@redhat.com>
PR c/79758
Index: gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/fail_image_1.f08 (Arbeitskopie)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+program fail_image_statement_1
+ implicit none
+
+ fail image ! OK
+ fail image (1) ! { dg-error "Syntax error in FAIL IMAGE statement at \\(1\\)" }
+
+end program fail_image_statement_1
+
Index: gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/fail_image_2.f08 (Arbeitskopie)
@@ -0,0 +1,10 @@
+! { dg-do run }
+
+program fail_image_statement_2
+ implicit none
+
+ fail image ! OK
+ error stop "This statement should not be reached."
+
+end program fail_image_statement_2
+
Index: gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 (Arbeitskopie)
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+program test_failed_images_1
+ implicit none
+
+ integer, allocatable :: fi(:)
+ real :: r
+ integer :: i
+
+ fi = failed_images() ! OK
+ fi = failed_images(TEAM=1) ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) not yet supported" }
+ fi = failed_images(KIND=1) ! OK
+ fi = failed_images(KIND=4) ! OK
+ fi = failed_images(KIND=0) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be positive" }
+ fi = failed_images(KIND=r) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be INTEGER" }
+ fi = failed_images(KIND=i) ! { dg-error "Constant expression required at \\\(1\\\)" }
+ fi = failed_images(KIND=42) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) shall specify a valid integer kind" }
+
+end program test_failed_images_1
+
Index: gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 (Arbeitskopie)
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+program test_failed_images_2
+ implicit none
+
+ integer, allocatable :: fi(:)
+ integer(kind=1), allocatable :: sfi(:)
+
+ fi = failed_images()
+ if (size(fi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=1)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=8)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+
+end program test_failed_images_2
+
Index: gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 (Arbeitskopie)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+
+program test_image_status_1
+ implicit none
+
+ integer :: isv
+ integer(kind=1) :: k1
+ integer(kind=2) :: k2
+ integer(kind=4) :: k4
+ integer(kind=8) :: k8
+
+ isv = image_status(1) ! Ok
+ isv = image_status(-1) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be positive" }
+ isv = image_status(0) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be positive" }
+ isv = image_status(.true.) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be INTEGER" }
+ isv = image_status([1,2,3]) ! { dg-error "'image' argument of 'image_status' intrinsic at \\(1\\) must be a scalar" }
+ isv = image_status(k1) ! Ok
+ isv = image_status(k2) ! Ok
+ isv = image_status(k4) ! Ok
+ isv = image_status(k8) ! Ok
+ isv = image_status(1, team=1) ! { dg-error "'team' argument of 'image_status' intrinsic at \\(1\\) not yet supported" }
+ isv = image_status() ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
+ isv = image_status(team=1) ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
+
+end program test_image_status_1
+
Index: gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 (Arbeitskopie)
@@ -0,0 +1,12 @@
+! { dg-do run }
+
+program test_image_status_2
+ use iso_fortran_env , only : STAT_STOPPED_IMAGE
+ implicit none
+
+ if (image_status(1) /= 0) error stop "Image 1 should report OK."
+ if (image_status(2) /= STAT_STOPPED_IMAGE) error stop "Image 2 should be stopped."
+ if (image_status(3) /= STAT_STOPPED_IMAGE) error stop "Image 3 should be stopped."
+
+end program test_image_status_2
+
Index: gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 (Arbeitskopie)
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+program test_stopped_images_1
+ implicit none
+
+ integer, allocatable :: gi(:)
+ real :: r
+ integer :: i
+
+ gi = stopped_images() ! OK
+ gi = stopped_images(TEAM=1) ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) not yet supported" }
+ gi = stopped_images(KIND=1) ! OK
+ gi = stopped_images(KIND=4) ! OK
+ gi = stopped_images(KIND=0) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be positive" }
+ gi = stopped_images(KIND=r) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be INTEGER" }
+ gi = stopped_images(KIND=i) ! { dg-error "Constant expression required at \\\(1\\\)" }
+ gi = stopped_images(KIND=42) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) shall specify a valid integer kind" }
+
+end program test_stopped_images_1
+
Index: gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 (Arbeitskopie)
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+program test_stopped_images_2
+ implicit none
+
+ integer, allocatable :: si(:)
+ integer(kind=1), allocatable :: ssi(:)
+
+ si = stopped_images()
+ if (size(si) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=1)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=8)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+
+end program test_stopped_images_2
+
Index: gcc/testsuite/gfortran.dg/coarray_fail_st.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_fail_st.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_fail_st.f90 (Arbeitskopie)
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program fail_statement
+ implicit none
+
+ integer :: me,np,stat
+
+ me = this_image()
+ np = num_images()
+ stat = 0
+
+ if(me == 1) fail image
+
+ sync all(stat=stat)
+
+ if(stat /= 0) write(*,*) 'Image failed during sync'
+
+end program fail_statement
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_fail_image \\\(0B\\\);" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_failed_images_1.f08 (Arbeitskopie)
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fcoarray=lib -lcaf_single" }
+
+program test_failed_images_1
+ implicit none
+
+ integer :: me,np,stat
+ character(len=1) :: c
+ integer, allocatable :: fi(:)
+ integer(kind=1), allocatable :: sfi(:)
+
+ fi = failed_images()
+ if (size(fi) > 0) error stop "failed_images result shall be empty array"
+ if (allocated(fi)) error stop "failed_images result shall not be allocated"
+
+ sfi = failed_images(KIND=1)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+ if (allocated(sfi)) error stop "failed_images result shall not be allocated"
+
+ sfi = failed_images(KIND=8)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+! The implicit type conversion in the assignment above allocates an array.
+! if (allocated(sfi)) error stop "failed_images result shall not be allocated"
+
+end program test_failed_images_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray_image_status_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_image_status_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_image_status_1.f08 (Arbeitskopie)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single -fdump-tree-original" }
+
+program test_image_status_1
+ use iso_fortran_env , only : STAT_STOPPED_IMAGE
+ implicit none
+
+ if (image_status(1) /= 0) error stop "image_status(1) should not fail"
+ if (image_status(42) /= STAT_STOPPED_IMAGE) error stop "image_status(42) should report stopped image"
+
+end program test_image_status_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(1, .+\\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(42, .+\\\)" 1 "original" } }
+
+
Index: gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_stopped_images_1.f08 (Arbeitskopie)
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fcoarray=lib -lcaf_single" }
+
+program test_stopped_images_1
+ implicit none
+
+ integer :: me,np,stat
+ character(len=1) :: c
+ integer, allocatable :: si(:)
+ integer(kind=1), allocatable :: ssi(:)
+
+ si = stopped_images()
+ if (size(si) > 0) error stop "stopped_images result shall be empty array at 1"
+ if (allocated(si)) error stop "stopped_images result shall not be allocated at 1"
+
+ ssi = stopped_images(KIND=1)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array at 2"
+ if (allocated(ssi)) error stop "stopped_images result shall not be allocated at 2"
+
+ ssi = stopped_images(KIND=8)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array at 3"
+! The implicit type conversion in the assignment above allocates an array.
+! if (allocated(ssi)) error stop "stopped_images result shall not be allocated at 3"
+
+end program test_stopped_images_1
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_stopped_images \\\(&D\\\.\[0-9\]+, 0B, D\\\.\[0-9\]+\\\);" 1 "original" } }
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog (Revision 245899)
+++ libgfortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+2017-03-05 Andre Vehreschild <vehre@gcc.gnu.org>
+ Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+ * caf/libcaf.h: Added prototypes and stat codes for failed and stopped
+ images.
+ * caf/single.c (void _gfortran_caf_fail_image): Add the routine.
+ (int _gfortran_caf_image_status): Same.
+ (_gfortran_caf_failed_images): Same.
+ (_gfortran_caf_stopped_images): Same.
+
2017-03-02 Thomas Koenig <tkoenig@gcc.gnu.org>
Jakub Jelinek <jakub@redhat.com>
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h (Revision 245899)
+++ libgfortran/caf/libcaf.h (Arbeitskopie)
@@ -41,15 +41,21 @@
#define likely(x) __builtin_expect(!!(x), 1)
#define unlikely(x) __builtin_expect(!!(x), 0)
#endif
+#endif
/* Definitions of the Fortran 2008 standard; need to kept in sync with
- ISO_FORTRAN_ENV, cf. libgfortran.h. */
-#define STAT_UNLOCKED 0
-#define STAT_LOCKED 1
-#define STAT_LOCKED_OTHER_IMAGE 2
-#define STAT_STOPPED_IMAGE 6000
-#endif
+ ISO_FORTRAN_ENV, cf. gcc/fortran/libgfortran.h. */
+typedef enum
+{
+ CAF_STAT_UNLOCKED = 0,
+ CAF_STAT_LOCKED,
+ CAF_STAT_LOCKED_OTHER_IMAGE,
+ CAF_STAT_STOPPED_IMAGE = 6000,
+ CAF_STAT_FAILED_IMAGE = 6001
+}
+caf_stat_codes_t;
+
/* Describes what type of array we are registerring. Keep in sync with
gcc/fortran/trans.h. */
typedef enum caf_register_t {
@@ -74,6 +80,7 @@
caf_deregister_t;
typedef void* caf_token_t;
+typedef void * caf_team_t;
typedef gfc_array_void gfc_descriptor_t;
/* Linked list of static coarrays registered. */
@@ -198,6 +205,7 @@
void _gfortran_caf_error_stop_str (const char *, int32_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
+void _gfortran_caf_fail_image (void) __attribute__ ((noreturn));
void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
@@ -243,6 +251,13 @@
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 *);
+void _gfortran_caf_failed_images (gfc_descriptor_t *,
+ caf_team_t * __attribute__ ((unused)), int *);
+int _gfortran_caf_image_status (int, caf_team_t * __attribute__ ((unused)));
+void _gfortran_caf_stopped_images (gfc_descriptor_t *,
+ caf_team_t * __attribute__ ((unused)),
+ int *);
+
int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
#endif /* LIBCAF_H */
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c (Revision 245899)
+++ libgfortran/caf/single.c (Arbeitskopie)
@@ -264,6 +264,7 @@
*stat = 0;
}
+
void
_gfortran_caf_stop_numeric(int32_t stop_code)
{
@@ -271,6 +272,7 @@
exit (0);
}
+
void
_gfortran_caf_stop_str(const char *string, int32_t len)
{
@@ -282,6 +284,7 @@
exit (0);
}
+
void
_gfortran_caf_error_stop_str (const char *string, int32_t len)
{
@@ -294,7 +297,75 @@
}
+/* Reported that the program terminated because of a fail image issued.
+ Because this is a single image library, nothing else than aborting the whole
+ program can be done. */
+
+void _gfortran_caf_fail_image (void)
+{
+ fputs ("IMAGE FAILED!\n", stderr);
+ exit (0);
+}
+
+
+/* Get the status of image IMAGE. Because being the single image library all
+ other images are reported to be stopped. */
+
+int _gfortran_caf_image_status (int image,
+ caf_team_t * team __attribute__ ((unused)))
+{
+ if (image == 1)
+ return 0;
+ else
+ return CAF_STAT_STOPPED_IMAGE;
+}
+
+
+/* Single image library. There can not be any failed images with only one
+ image. */
+
void
+_gfortran_caf_failed_images (gfc_descriptor_t *array,
+ caf_team_t * team __attribute__ ((unused)),
+ int * kind)
+{
+ int local_kind = kind != NULL ? *kind : 4;
+
+ array->base_addr = NULL;
+ array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
+ | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+ /* Setting lower_bound higher then upper_bound is what the compiler does to
+ indicate an empty array. */
+ array->dim[0].lower_bound = 0;
+ array->dim[0]._ubound = -1;
+ array->dim[0]._stride = 1;
+ array->offset = 0;
+}
+
+
+/* With only one image available no other images can be stopped. Therefore
+ return an empty array. */
+
+void
+_gfortran_caf_stopped_images (gfc_descriptor_t *array,
+ caf_team_t * team __attribute__ ((unused)),
+ int * kind)
+{
+ int local_kind = kind != NULL ? *kind : 4;
+
+ array->base_addr = NULL;
+ array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
+ | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+ /* Setting lower_bound higher then upper_bound is what the compiler does to
+ indicate an empty array. */
+ array->dim[0].lower_bound = 0;
+ array->dim[0]._ubound = -1;
+ array->dim[0]._stride = 1;
+ array->offset = 0;
+}
+
+
+void
_gfortran_caf_error_stop (int32_t error)
{
fprintf (stderr, "ERROR STOP %d\n", error);
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-05 11:41 ` Andre Vehreschild
@ 2017-03-08 22:58 ` Christophe Lyon
2017-03-09 8:45 ` Andre Vehreschild
0 siblings, 1 reply; 9+ messages in thread
From: Christophe Lyon @ 2017-03-08 22:58 UTC (permalink / raw)
To: Andre Vehreschild
Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML,
Alessandro Fanfarillo, Damian Rouson
Hi,
On 5 March 2017 at 12:41, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Jerry,
>
> thanks for seconding my read of the standard and reviewing so quickly.
> Committed as r245900.
>
I've noticed that the new test:
gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2 -latomic
execution test
fails on arm and aarch64.
I'm using qemu if it matters, and my gfortran.log has:
spawn /XXX/qemu-wrapper.sh ./fail_image_2.exe
FAIL: gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2
-latomic execution test
that is, no obvious error message :-(
Am I the only one seeing this?
Thanks,
Christophe
> Regards,
> Andre
>
> On Sat, 4 Mar 2017 15:06:25 -0800
> Jerry DeLisle <jvdelisle@charter.net> wrote:
>
>> On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
>> > Hi all,
>> >
>> > attached patch polishes the one begun by Alessandro. It adds documentation
>> > and fixes the style issues. Furthermore did I try to interpret the standard
>> > according to the FAIL IMAGE statement. IMHO should it just quit the
>> > executable without any error code. The caf_single library emits "FAIL
>> > IMAGE" to stderr, while in coarray=single mode it just quits. What do you
>> > think?
>> >
>> > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be
>> > later).
>> >
>> > Gruß,
>> > Andre
>> >
>>
>> From my read:
>>
>> "A failed image is usually associated with a hardware failure of the
>> processor, memory system, or interconnection network"
>>
>> Since the FAIL IMAGE statement is intended to simulate such failure, I agree
>> with your interpretation as well, it just stops execution.
>>
>> Yes OK for trunk now.
>>
>> Jerry
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-08 22:58 ` Christophe Lyon
@ 2017-03-09 8:45 ` Andre Vehreschild
2017-03-10 6:48 ` Christophe Lyon
0 siblings, 1 reply; 9+ messages in thread
From: Andre Vehreschild @ 2017-03-09 8:45 UTC (permalink / raw)
To: Christophe Lyon
Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML,
Alessandro Fanfarillo, Damian Rouson
Hi Christophe,
you are right, that error message does not help a bit. Can you manually compile
and execute the testcase? Does it print "ERROR STOP: This statement should not
be reached."?
If not what does
fail_image_2 && echo "yes" || echo "no"
print? It should be "yes"
- Andre
On Wed, 8 Mar 2017 23:58:10 +0100
Christophe Lyon <christophe.lyon@linaro.org> wrote:
> Hi,
>
> On 5 March 2017 at 12:41, Andre Vehreschild <vehre@gmx.de> wrote:
> > Hi Jerry,
> >
> > thanks for seconding my read of the standard and reviewing so quickly.
> > Committed as r245900.
> >
>
> I've noticed that the new test:
> gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2 -latomic
> execution test
> fails on arm and aarch64.
> I'm using qemu if it matters, and my gfortran.log has:
> spawn /XXX/qemu-wrapper.sh ./fail_image_2.exe
> FAIL: gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2
> -latomic execution test
>
> that is, no obvious error message :-(
>
> Am I the only one seeing this?
>
> Thanks,
>
> Christophe
>
> > Regards,
> > Andre
> >
> > On Sat, 4 Mar 2017 15:06:25 -0800
> > Jerry DeLisle <jvdelisle@charter.net> wrote:
> >
> >> On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
> >> > Hi all,
> >> >
> >> > attached patch polishes the one begun by Alessandro. It adds
> >> > documentation and fixes the style issues. Furthermore did I try to
> >> > interpret the standard according to the FAIL IMAGE statement. IMHO
> >> > should it just quit the executable without any error code. The
> >> > caf_single library emits "FAIL IMAGE" to stderr, while in coarray=single
> >> > mode it just quits. What do you think?
> >> >
> >> > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be
> >> > later).
> >> >
> >> > Gruß,
> >> > Andre
> >> >
> >>
> >> From my read:
> >>
> >> "A failed image is usually associated with a hardware failure of the
> >> processor, memory system, or interconnection network"
> >>
> >> Since the FAIL IMAGE statement is intended to simulate such failure, I
> >> agree with your interpretation as well, it just stops execution.
> >>
> >> Yes OK for trunk now.
> >>
> >> Jerry
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-09 8:45 ` Andre Vehreschild
@ 2017-03-10 6:48 ` Christophe Lyon
2017-03-10 7:50 ` Andre Vehreschild
0 siblings, 1 reply; 9+ messages in thread
From: Christophe Lyon @ 2017-03-10 6:48 UTC (permalink / raw)
To: Andre Vehreschild
Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML,
Alessandro Fanfarillo, Damian Rouson
On 9 March 2017 at 09:45, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Christophe,
>
> you are right, that error message does not help a bit. Can you manually compile
> and execute the testcase? Does it print "ERROR STOP: This statement should not
> be reached."?
>
> If not what does
>
> fail_image_2 && echo "yes" || echo "no"
>
> print? It should be "yes"
>
I restarted the build manually, and the program exits without printing
anything, and the return code is 0.
What is missing in gfortran.log is the "EXIT code 0" string.
It looks like an unexpected interaction between qemu and
the way the program exists, meaning that the exit code
is not properly detected by dejagnu.
I'll try to debug that, it looks like a setting is missing in
my validation environment.
Thanks,
Christophe
> - Andre
>
> On Wed, 8 Mar 2017 23:58:10 +0100
> Christophe Lyon <christophe.lyon@linaro.org> wrote:
>
>> Hi,
>>
>> On 5 March 2017 at 12:41, Andre Vehreschild <vehre@gmx.de> wrote:
>> > Hi Jerry,
>> >
>> > thanks for seconding my read of the standard and reviewing so quickly.
>> > Committed as r245900.
>> >
>>
>> I've noticed that the new test:
>> gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2 -latomic
>> execution test
>> fails on arm and aarch64.
>> I'm using qemu if it matters, and my gfortran.log has:
>> spawn /XXX/qemu-wrapper.sh ./fail_image_2.exe
>> FAIL: gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2
>> -latomic execution test
>>
>> that is, no obvious error message :-(
>>
>> Am I the only one seeing this?
>>
>> Thanks,
>>
>> Christophe
>>
>> > Regards,
>> > Andre
>> >
>> > On Sat, 4 Mar 2017 15:06:25 -0800
>> > Jerry DeLisle <jvdelisle@charter.net> wrote:
>> >
>> >> On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
>> >> > Hi all,
>> >> >
>> >> > attached patch polishes the one begun by Alessandro. It adds
>> >> > documentation and fixes the style issues. Furthermore did I try to
>> >> > interpret the standard according to the FAIL IMAGE statement. IMHO
>> >> > should it just quit the executable without any error code. The
>> >> > caf_single library emits "FAIL IMAGE" to stderr, while in coarray=single
>> >> > mode it just quits. What do you think?
>> >> >
>> >> > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? (May be
>> >> > later).
>> >> >
>> >> > Gruß,
>> >> > Andre
>> >> >
>> >>
>> >> From my read:
>> >>
>> >> "A failed image is usually associated with a hardware failure of the
>> >> processor, memory system, or interconnection network"
>> >>
>> >> Since the FAIL IMAGE statement is intended to simulate such failure, I
>> >> agree with your interpretation as well, it just stops execution.
>> >>
>> >> Yes OK for trunk now.
>> >>
>> >> Jerry
>> >
>> >
>> > --
>> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH, Fortran, Coarray, v1] Add support for failed images
2017-03-10 6:48 ` Christophe Lyon
@ 2017-03-10 7:50 ` Andre Vehreschild
0 siblings, 0 replies; 9+ messages in thread
From: Andre Vehreschild @ 2017-03-10 7:50 UTC (permalink / raw)
To: Christophe Lyon
Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML,
Alessandro Fanfarillo, Damian Rouson
Hi Christophe,
The testcase is not expected to output anything. So only the exit code should be set to zero. I called libgfortrans exit-function to quit the program. I am not aware that I need to do more. Happy for any insight what goes wrong. There are also issues on hpux, but I think they have a different cause.
- Andre
Am 10. März 2017 07:48:12 MEZ schrieb Christophe Lyon <christophe.lyon@linaro.org>:
>On 9 March 2017 at 09:45, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi Christophe,
>>
>> you are right, that error message does not help a bit. Can you
>manually compile
>> and execute the testcase? Does it print "ERROR STOP: This statement
>should not
>> be reached."?
>>
>> If not what does
>>
>> fail_image_2 && echo "yes" || echo "no"
>>
>> print? It should be "yes"
>>
>
>I restarted the build manually, and the program exits without printing
>anything, and the return code is 0.
>
>What is missing in gfortran.log is the "EXIT code 0" string.
>It looks like an unexpected interaction between qemu and
>the way the program exists, meaning that the exit code
>is not properly detected by dejagnu.
>I'll try to debug that, it looks like a setting is missing in
>my validation environment.
>
>Thanks,
>
>Christophe
>
>> - Andre
>>
>> On Wed, 8 Mar 2017 23:58:10 +0100
>> Christophe Lyon <christophe.lyon@linaro.org> wrote:
>>
>>> Hi,
>>>
>>> On 5 March 2017 at 12:41, Andre Vehreschild <vehre@gmx.de> wrote:
>>> > Hi Jerry,
>>> >
>>> > thanks for seconding my read of the standard and reviewing so
>quickly.
>>> > Committed as r245900.
>>> >
>>>
>>> I've noticed that the new test:
>>> gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2 -latomic
>>> execution test
>>> fails on arm and aarch64.
>>> I'm using qemu if it matters, and my gfortran.log has:
>>> spawn /XXX/qemu-wrapper.sh ./fail_image_2.exe
>>> FAIL: gfortran.dg/coarray/fail_image_2.f08 -fcoarray=single -O2
>>> -latomic execution test
>>>
>>> that is, no obvious error message :-(
>>>
>>> Am I the only one seeing this?
>>>
>>> Thanks,
>>>
>>> Christophe
>>>
>>> > Regards,
>>> > Andre
>>> >
>>> > On Sat, 4 Mar 2017 15:06:25 -0800
>>> > Jerry DeLisle <jvdelisle@charter.net> wrote:
>>> >
>>> >> On 03/04/2017 09:58 AM, Andre Vehreschild wrote:
>>> >> > Hi all,
>>> >> >
>>> >> > attached patch polishes the one begun by Alessandro. It adds
>>> >> > documentation and fixes the style issues. Furthermore did I try
>to
>>> >> > interpret the standard according to the FAIL IMAGE statement.
>IMHO
>>> >> > should it just quit the executable without any error code. The
>>> >> > caf_single library emits "FAIL IMAGE" to stderr, while in
>coarray=single
>>> >> > mode it just quits. What do you think?
>>> >> >
>>> >> > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk?
>(May be
>>> >> > later).
>>> >> >
>>> >> > Gruß,
>>> >> > Andre
>>> >> >
>>> >>
>>> >> From my read:
>>> >>
>>> >> "A failed image is usually associated with a hardware failure of
>the
>>> >> processor, memory system, or interconnection network"
>>> >>
>>> >> Since the FAIL IMAGE statement is intended to simulate such
>failure, I
>>> >> agree with your interpretation as well, it just stops execution.
>>> >>
>>> >> Yes OK for trunk now.
>>> >>
>>> >> Jerry
>>> >
>>> >
>>> > --
>>> > Andre Vehreschild * Email: vehre ad gmx dot de
>>
>>
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 929 10 18 * vehre@gmx.de
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2017-03-10 7:50 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-03-04 17:59 [PATCH, Fortran, Coarray, v1] Add support for failed images Andre Vehreschild
2017-03-04 19:52 ` Alessandro Fanfarillo
2017-03-04 20:25 ` Andre Vehreschild
2017-03-04 23:06 ` Jerry DeLisle
2017-03-05 11:41 ` Andre Vehreschild
2017-03-08 22:58 ` Christophe Lyon
2017-03-09 8:45 ` Andre Vehreschild
2017-03-10 6:48 ` Christophe Lyon
2017-03-10 7:50 ` Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).