Support F2018 QUIET specifier for STOP and ERROR STOP statements

Fortran 2018 adds a QUIET specifier to the STOP and ERROR STOP
statements, allowing the programmer to suppress the output of
signaling FP exceptions and the stop code.

This patch adds the necessary changes to OpenCoarrays due to the
GFortran changes to handle this specifier. See GFortran PR 84519.

Author: jabl

src/libcaf.h

@@ -215,8 +215,10 @@ typedef struct caf_reference_t {
 /* The type to use for string lengths.  */
 #ifdef GCC_GE_8
 typedef size_t charlen_t;
+#define QUIETARG , bool
 #else
 typedef int charlen_t;
+#define QUIETARG
 #endif
 
 /* Common auxiliary functions: caf_auxiliary.c.  */
@@ -279,11 +281,12 @@ void PREFIX (sync_all) (int *, char *, charlen_t);
 void PREFIX (sync_images) (int, int[], int *, char *, charlen_t);
 void PREFIX (sync_memory) (int *, char *, charlen_t);
 
-void PREFIX (stop_str) (const char *, charlen_t) __attribute__ ((noreturn));
-void PREFIX (stop) (int) __attribute__ ((noreturn));
-void PREFIX (error_stop_str) (const char *, charlen_t)
+void PREFIX (stop_str) (const char *, charlen_t QUIETARG) __attribute__ ((noreturn));
+void PREFIX (stop) (int QUIETARG) __attribute__ ((noreturn));
+void PREFIX (error_stop_str) (const char *, charlen_t QUIETARG)
      __attribute__ ((noreturn));
-void PREFIX (error_stop) (int) __attribute__ ((noreturn));
+void PREFIX (error_stop) (int QUIETARG) __attribute__ ((noreturn));
+
 void PREFIX (fail_image) (void) __attribute__ ((noreturn));
 
 void PREFIX (form_team) (int, caf_team_t *, int);

src/mpi/mpi_caf.c

@@ -148,6 +148,7 @@ static void terminate_internal (int stat_code, int exit_code)
             __attribute__ ((noreturn));
 static void sync_images_internal (int count, int images[], int *stat,
                                   char *errmsg, size_t errmsg_len, bool internal);
+static void error_stop_str (const char *string, size_t len, bool quiet) __attribute__((noreturn));
 
 /* Global variables.  */
 static int caf_this_image;
@@ -2699,7 +2700,7 @@ PREFIX (sendget) (caf_token_t token_s, size_t offset_s, int image_index_s,
           char error_str[error_len];
           strcpy (error_str, "MPI-error: ");
           MPI_Error_string (mpi_error, &error_str[11], &error_len);
-          PREFIX (error_stop_str) (error_str, error_len + 11);
+          error_stop_str (error_str, error_len + 11, false);
         }
     }
 }
@@ -3269,7 +3270,7 @@ PREFIX (send) (caf_token_t token, size_t offset, int image_index,
           char error_str[error_len];
           strcpy (error_str, "MPI-error: ");
           MPI_Error_string (mpi_error, &error_str[11], &error_len);
-          PREFIX (error_stop_str) (error_str, error_len + 11);
+          error_stop_str (error_str, error_len + 11, false);
         }
     }
 }
@@ -3779,7 +3780,7 @@ PREFIX (get) (caf_token_t token, size_t offset, int image_index,
           char error_str[error_len + 11];
           strcpy (error_str, "MPI-error: ");
           MPI_Error_string (mpi_error, &error_str[11], &error_len);
-          PREFIX (error_stop_str) (error_str, error_len + 11);
+          error_stop_str (error_str, error_len + 11, false);
         }
     }
 }
@@ -7405,12 +7406,21 @@ terminate_internal (int stat_code, int exit_code)
 }
 
 
+#ifdef GCC_GE_8
+#undef QUIETARG
+#define QUIETARG , bool quiet
+#endif
+
 /* STOP function for integer arguments.  */
 
 void
-PREFIX (stop_numeric) (int stop_code)
+PREFIX (stop_numeric) (int stop_code QUIETARG)
 {
-  fprintf (stderr, "STOP %d\n", stop_code);
+#ifndef GCC_GE_8
+  bool quiet = false;
+#endif
+  if (!quiet)
+    fprintf (stderr, "STOP %d\n", stop_code);
 
   /* Stopping includes taking down the runtime regularly and returning the
    * stop_code. */
@@ -7421,38 +7431,59 @@ PREFIX (stop_numeric) (int stop_code)
 /* STOP function for string arguments.  */
 
 void
-PREFIX (stop_str) (const char *string, charlen_t len)
+PREFIX (stop_str) (const char *string, charlen_t len QUIETARG)
 {
-  fputs ("STOP ", stderr);
-  while (len--)
-    fputc (*(string++), stderr);
-  fputs ("\n", stderr);
-
+#ifndef GCC_GE_8
+  bool quiet = false;
+#endif
+  if (!quiet)
+    {
+      fputs ("STOP ", stderr);
+      while (len--)
+	fputc (*(string++), stderr);
+      fputs ("\n", stderr);
+    }
   /* Stopping includes taking down the runtime regularly. */
   terminate_internal (STAT_STOPPED_IMAGE, 0);
 }
 
 
 /* ERROR STOP function for string arguments.  */
 
-void
-PREFIX (error_stop_str) (const char *string, charlen_t len)
+static void
+error_stop_str (const char *string, size_t len, bool quiet)
 {
-  fputs ("ERROR STOP ", stderr);
-  while (len--)
-    fputc (*(string++), stderr);
-  fputs ("\n", stderr);
-
+  if (!quiet)
+    {
+      fputs ("ERROR STOP ", stderr);
+      while (len--)
+	fputc (*(string++), stderr);
+      fputs ("\n", stderr);
+    }
   terminate_internal (STAT_STOPPED_IMAGE, 1);
 }
 
 
+void
+PREFIX (error_stop_str) (const char *string, charlen_t len QUIETARG)
+{
+#ifndef GCC_GE_8
+  bool quiet = false;
+#endif
+  error_stop_str (string, len, quiet);
+}
+
+
 /* ERROR STOP function for numerical arguments.  */
 
 void
-PREFIX (error_stop) (int error)
+PREFIX (error_stop) (int error QUIETARG)
 {
-  fprintf (stderr, "ERROR STOP %d\n", error);
+#ifndef GCC_GE_8
+  bool quiet = false;
+#endif
+  if (!quiet)
+    fprintf (stderr, "ERROR STOP %d\n", error);
 
   terminate_internal (STAT_STOPPED_IMAGE, error);
 }