[PATCH] PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

[PATCH] PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

[Janne Blomqvist]

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, Ok for trunk?

(If accepted, I will handle the necessary changes to OpenCoarrays as
well).

gcc/fortran/ChangeLog:

2018-02-22  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-22  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.
---
 gcc/fortran/trans-decl.c    | 10 +++++----
 gcc/fortran/trans-stmt.c    | 13 ++++++-----
 libgfortran/caf/libcaf.h    |  8 +++----
 libgfortran/caf/mpi.c       | 19 +++++++++-------
 libgfortran/caf/single.c    | 42 ++++++++++++++++++++---------------
 libgfortran/libgfortran.h   |  2 +-
 libgfortran/runtime/pause.c |  2 +-
 libgfortran/runtime/stop.c  | 53 +++++++++++++++++++++++++++------------------
 8 files changed, 87 insertions(+), 62 deletions(-)

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e8c10d4..c233a0e 100644
--- 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 f1fe8a0..cf76fd0 100644
--- 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 198a0e9..dd97166 100644
--- 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 14c10b5..55d9908 100644
--- 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 053ec87..1ad13bd 100644
--- 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 072dc86..ca06e6d 100644
--- 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 3b4c17b..37672d4 100644
--- 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 3ef1350..1e6dd8c 100644
--- 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);
 }
-- 
2.7.4

Re: [PATCH] PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

[Steve Kargl]

On Thu, Feb 22, 2018 at 09:42:02PM +0200, Janne Blomqvist wrote:
> 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, Ok for trunk?
> 

OK.

-- 
steve

Re: [PATCH] PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

[Janne Blomqvist]

On Thu, Feb 22, 2018 at 10:16 PM, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Thu, Feb 22, 2018 at 09:42:02PM +0200, Janne Blomqvist wrote:
>> 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, Ok for trunk?
>>
>
> OK.

Thanks. Committed as r257928.

The corresponding OpenCoarrays pull request is
https://github.com/sourceryinstitute/OpenCoarrays/pull/510


-- 
Janne Blomqvist