diff options
Diffstat (limited to 'libgfortran/caf/single.c')
-rw-r--r-- | libgfortran/caf/single.c | 25 |
1 files changed, 19 insertions, 6 deletions
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index 603a910..2258f2f 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -28,6 +28,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <stdio.h> /* For fputs and fprintf. */ #include <stdlib.h> /* For exit and malloc. */ #include <string.h> /* For memcpy and memset. */ +#include <stdarg.h> /* For variadic arguments. */ /* Define GFC_CAF_CHECK to enable run-time checking. */ /* #define GFC_CAF_CHECK 1 */ @@ -40,6 +41,21 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see caf_static_t *caf_static_list = NULL; +/* Keep in sync with mpi.c. */ +static void +caf_runtime_error (const char *message, ...) +{ + va_list ap; + fprintf (stderr, "Fortran runtime error: "); + va_start (ap, message); + fprintf (stderr, message, ap); + va_end (ap); + fprintf (stderr, "\n"); + + /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */ + exit (EXIT_FAILURE); +} + void _gfortran_caf_init (int *argc __attribute__ ((unused)), char ***argv __attribute__ ((unused)), @@ -73,12 +89,12 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token, if (unlikely (local == NULL || token == NULL)) { + const char msg[] = "Failed to allocate coarray"; if (stat) { *stat = 1; if (errmsg_len > 0) { - const char msg[] = "Failed to allocate coarray"; int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len : (int) sizeof (msg); memcpy (errmsg, msg, len); @@ -88,10 +104,7 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token, return NULL; } else - { - fprintf (stderr, "ERROR: Failed to allocate coarray"); - exit (1); - } + caf_runtime_error (msg); } if (stat) @@ -140,7 +153,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)), { fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC " "IMAGES", images[i]); - exit (1); + exit (EXIT_FAILURE); } #endif |