PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

Fortran 2018 adds a new QUIET specifier for the STOP and ERROR STOP
statements, in order to suppress the printing of signaling FP
exceptions and the stop code. This patch adds the necessary library
changes, but for now the new specifier is not parsed and the frontend
unconditionally adds a false value for the new argument.

Regtested on x86_64-pc-linux-gnu.

gcc/fortran/ChangeLog:

2018-02-23  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/84519
	* trans-decl.c (gfc_build_builtin_function_decls): Add bool
	argument to stop and error stop decls.
	* trans-stmt.c (gfc_trans_stop): Add false value to argument
	lists.

libgfortran/ChangeLog:

2018-02-23  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/84519
	* caf/libcaf.h (_gfortran_caf_stop_numeric): Add bool argument.
	(_gfortran_caf_stop_str): Likewise.
	(_gfortran_caf_error_stop_str): Likewise.
	(_gfortran_caf_error_stop): Likewise.
	* caf/mpi.c (_gfortran_caf_error_stop_str): Handle new argument.
	(_gfortran_caf_error_stop): Likewise.
	* caf/single.c (_gfortran_caf_stop_numeric): Likewise.
	(_gfortran_caf_stop_str): Likewise.
	(_gfortran_caf_error_stop_str): Likewise.
	(_gfortran_caf_error_stop): Likewise.
	(_gfortran_caf_lock): Likewise.
	(_gfortran_caf_unlock): Likewise.
	* libgfortran.h (stop_string): Add bool argument.
	* runtime/pause.c (do_pause): Add false argument.
	* runtime/stop.c (stop_numeric): Handle new argument.
	(stop_string): Likewise.
	(error_stop_string): Likewise.
	(error_stop_numeric): Likewise.

From-SVN: r257928

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c4cc44775e117845d52c34ff4d6712b8bb36d812..3b56c37d96f17a6f5c333fb42351e0be76358941 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-02-23  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR fortran/84519
+       * trans-decl.c (gfc_build_builtin_function_decls): Add bool
+       argument to stop and error stop decls.
+       * trans-stmt.c (gfc_trans_stop): Add false value to argument
+       lists.
+
 2018-02-22  Janne Blomqvist  <jb@gcc.gnu.org>
 
        PR 78534

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e8c10d4d5386c28816bcf8f57f56b6204eb9f38f..c233a0ee81f7c7b172bfd081c66c001a2ff7b137 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3503,25 +3503,27 @@ gfc_build_builtin_function_decls (void)
 
   gfor_fndecl_stop_numeric = gfc_build_library_function_decl (
        get_identifier (PREFIX("stop_numeric")),
-       void_type_node, 1, integer_type_node);
+       void_type_node, 2, integer_type_node, boolean_type_node);
   /* STOP doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1;
 
   gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec (
        get_identifier (PREFIX("stop_string")), ".R.",
-       void_type_node, 2, pchar_type_node, size_type_node);
+       void_type_node, 3, pchar_type_node, size_type_node,
+       boolean_type_node);
   /* STOP doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1;
 
   gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl (
         get_identifier (PREFIX("error_stop_numeric")),
-        void_type_node, 1, integer_type_node);
+        void_type_node, 2, integer_type_node, boolean_type_node);
   /* ERROR STOP doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1;
 
   gfor_fndecl_error_stop_string = gfc_build_library_function_decl_with_spec (
        get_identifier (PREFIX("error_stop_string")), ".R.",
-       void_type_node, 2, pchar_type_node, size_type_node);
+       void_type_node, 3, pchar_type_node, size_type_node,
+       boolean_type_node);
   /* ERROR STOP doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1;
 

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index f1fe8a0d9d1d5b07e96c199372eccdb8a04e607f..cf76fd0162bd06de4b03735f7d6d5af9e5862c43 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -642,7 +642,8 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
                                 : (flag_coarray == GFC_FCOARRAY_LIB
                                    ? gfor_fndecl_caf_stop_str
                                    : gfor_fndecl_stop_string),
-                                2, build_int_cst (pchar_type_node, 0), tmp);
+                                3, build_int_cst (pchar_type_node, 0), tmp,
+                                boolean_false_node);
     }
   else if (code->expr1->ts.type == BT_INTEGER)
     {
@@ -654,8 +655,9 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
                                    : gfor_fndecl_error_stop_numeric)
                                 : (flag_coarray == GFC_FCOARRAY_LIB
                                    ? gfor_fndecl_caf_stop_numeric
-                                   : gfor_fndecl_stop_numeric), 1,
-                                fold_convert (integer_type_node, se.expr));
+                                   : gfor_fndecl_stop_numeric), 2,
+                                fold_convert (integer_type_node, se.expr),
+                                boolean_false_node);
     }
   else
     {
@@ -668,8 +670,9 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
                                 : (flag_coarray == GFC_FCOARRAY_LIB
                                    ? gfor_fndecl_caf_stop_str
                                    : gfor_fndecl_stop_string),
-                                2, se.expr, fold_convert (size_type_node,
-                                                          se.string_length));
+                                3, se.expr, fold_convert (size_type_node,
+                                                          se.string_length),
+                                boolean_false_node);
     }
 
   gfc_add_expr_to_block (&se.pre, tmp);

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 198a0e9efd3ae2a9de3aa24fb728d18bdaf54ec3..dd97166952c1479cf3ad2a4f1de9e2ce339e5f01 100644 (file)
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -197,13 +197,13 @@ void _gfortran_caf_sync_all (int *, char *, size_t);
 void _gfortran_caf_sync_memory (int *, char *, size_t);
 void _gfortran_caf_sync_images (int, int[], int *, char *, size_t);
 
-void _gfortran_caf_stop_numeric (int)
+void _gfortran_caf_stop_numeric (int, bool)
      __attribute__ ((noreturn));
-void _gfortran_caf_stop_str (const char *, size_t)
+void _gfortran_caf_stop_str (const char *, size_t, bool)
      __attribute__ ((noreturn));
-void _gfortran_caf_error_stop_str (const char *, size_t)
+void _gfortran_caf_error_stop_str (const char *, size_t, bool)
      __attribute__ ((noreturn));
-void _gfortran_caf_error_stop (int) __attribute__ ((noreturn));
+void _gfortran_caf_error_stop (int, bool) __attribute__ ((noreturn));
 void _gfortran_caf_fail_image (void) __attribute__ ((noreturn));
 
 void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, size_t);

diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c
index 14c10b536e3863651561cc59e59ef524707bdb72..55d9908b8de5aa94136f489784445070814781b4 100644 (file)
--- a/libgfortran/caf/mpi.c
+++ b/libgfortran/caf/mpi.c
@@ -358,13 +358,15 @@ error_stop (int error)
 /* ERROR STOP function for string arguments.  */
 
 void
-_gfortran_caf_error_stop_str (const char *string, size_t len)
+_gfortran_caf_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);
+    }
   error_stop (1);
 }
 
@@ -372,8 +374,9 @@ _gfortran_caf_error_stop_str (const char *string, size_t len)
 /* ERROR STOP function for numerical arguments.  */
 
 void
-_gfortran_caf_error_stop (int error)
+_gfortran_caf_error_stop (int error, bool quiet)
 {
-  fprintf (stderr, "ERROR STOP %d\n", error);
+  if (!quiet)
+    fprintf (stderr, "ERROR STOP %d\n", error);
   error_stop (error);
 }

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 053ec87d562a6893dfaa439c023106a2f6ecfe39..1ad13bd5643843e4342a9ae3a0505dafce7a74fa 100644 (file)
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -267,33 +267,38 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
 
 
 void
-_gfortran_caf_stop_numeric(int stop_code)
+_gfortran_caf_stop_numeric(int stop_code, bool quiet)
 {
-  fprintf (stderr, "STOP %d\n", stop_code);
+  if (!quiet)
+    fprintf (stderr, "STOP %d\n", stop_code);
   exit (0);
 }
 
 
 void
-_gfortran_caf_stop_str(const char *string, size_t len)
+_gfortran_caf_stop_str(const char *string, size_t len, bool quiet)
 {
-  fputs ("STOP ", stderr);
-  while (len--)
-    fputc (*(string++), stderr);
-  fputs ("\n", stderr);
-
+  if (!quiet)
+    {
+      fputs ("STOP ", stderr);
+      while (len--)
+       fputc (*(string++), stderr);
+      fputs ("\n", stderr);
+    }
   exit (0);
 }
 
 
 void
-_gfortran_caf_error_stop_str (const char *string, size_t len)
+_gfortran_caf_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);
+    }
   exit (1);
 }
 
@@ -367,9 +372,10 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
 
 
 void
-_gfortran_caf_error_stop (int error)
+_gfortran_caf_error_stop (int error, bool quiet)
 {
-  fprintf (stderr, "ERROR STOP %d\n", error);
+  if (!quiet)
+    fprintf (stderr, "ERROR STOP %d\n", error);
   exit (error);
 }
 
@@ -2990,7 +2996,7 @@ _gfortran_caf_lock (caf_token_t token, size_t index,
        }
       return;
     }
-  _gfortran_caf_error_stop_str (msg, strlen (msg));
+  _gfortran_caf_error_stop_str (msg, strlen (msg), false);
 }
 
 
@@ -3023,7 +3029,7 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
        }
       return;
     }
-  _gfortran_caf_error_stop_str (msg, strlen (msg));
+  _gfortran_caf_error_stop_str (msg, strlen (msg), false);
 }
 
 int

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 072dc869be8ef7ca79754e18740698e47928cc54..ca06e6db6205beb248d9594ed7d3caaa2fef3d03 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -888,7 +888,7 @@ internal_proto(filename_from_unit);
 
 /* stop.c */
 
-extern _Noreturn void stop_string (const char *, size_t);
+extern _Noreturn void stop_string (const char *, size_t, bool);
 export_proto(stop_string);
 
 /* reshape_packed.c */

diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 3b4c17b8932f50ea6d357e4fecbdebae3dd1d2b6..37672d4a02cbbb03e6c7aebb50c33beb43e823f4 100644 (file)
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -40,7 +40,7 @@ do_pause (void)
 
   fgets(buff, 4, stdin);
   if (strncmp(buff, "go\n", 3) != 0)
-    stop_string ('\0', 0);
+    stop_string ('\0', 0, false);
   estr_write ("RESUMED\n");
 }
 

diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 3ef1350c281104de83226eb467d5ef8603010573..1e6dd8c28d0acabc3bc2597e40e2dfac12c3235c 100644 (file)
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -81,14 +81,17 @@ report_exception (void)
 
 /* A numeric STOP statement.  */
 
-extern _Noreturn void stop_numeric (int);
+extern _Noreturn void stop_numeric (int, bool);
 export_proto(stop_numeric);
 
 void
-stop_numeric (int code)
+stop_numeric (int code, bool quiet)
 {
-  report_exception ();
-  st_printf ("STOP %d\n", code);
+  if (!quiet)
+    {
+      report_exception ();
+      st_printf ("STOP %d\n", code);
+    }
   exit (code);
 }
 
@@ -96,14 +99,17 @@ stop_numeric (int code)
 /* A character string or blank STOP statement.  */
 
 void
-stop_string (const char *string, size_t len)
+stop_string (const char *string, size_t len, bool quiet)
 {
-  report_exception ();
-  if (string)
+  if (!quiet)
     {
-      estr_write ("STOP ");
-      (void) write (STDERR_FILENO, string, len);
-      estr_write ("\n");
+      report_exception ();
+      if (string)
+       {
+         estr_write ("STOP ");
+         (void) write (STDERR_FILENO, string, len);
+         estr_write ("\n");
+       }
     }
   exit (0);
 }
@@ -114,30 +120,35 @@ stop_string (const char *string, size_t len)
    initiates error termination of execution."  Thus, error_stop_string returns
    a nonzero exit status code.  */
 
-extern _Noreturn void error_stop_string (const char *, size_t);
+extern _Noreturn void error_stop_string (const char *, size_t, bool);
 export_proto(error_stop_string);
 
 void
-error_stop_string (const char *string, size_t len)
+error_stop_string (const char *string, size_t len, bool quiet)
 {
-  report_exception ();
-  estr_write ("ERROR STOP ");
-  (void) write (STDERR_FILENO, string, len);
-  estr_write ("\n");
-
+  if (!quiet)
+    {
+      report_exception ();
+      estr_write ("ERROR STOP ");
+      (void) write (STDERR_FILENO, string, len);
+      estr_write ("\n");
+    }
   exit_error (1);
 }
 
 
 /* A numeric ERROR STOP statement.  */
 
-extern _Noreturn void error_stop_numeric (int);
+extern _Noreturn void error_stop_numeric (int, bool);
 export_proto(error_stop_numeric);
 
 void
-error_stop_numeric (int code)
+error_stop_numeric (int code, bool quiet)
 {
-  report_exception ();
-  st_printf ("ERROR STOP %d\n", code);
+  if (!quiet)
+    {
+      report_exception ();
+      st_printf ("ERROR STOP %d\n", code);
+    }
   exit_error (code);
 }