OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR 84519 Handle optional QUIET specifier for STOP and ERROR STOP

Browse Source 
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
This commit is contained in:
Janne Blomqvist 2018-02-23 11:07:24 +02:00
parent 355436fb15
commit dffb1e2279
9 changed files with 95 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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

10
gcc/fortran/trans-decl.c
View File

@ -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;

13
gcc/fortran/trans-stmt.c
View File

@ -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);

8
libgfortran/caf/libcaf.h
View File

@ -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);

19
libgfortran/caf/mpi.c
View File

@ -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);
}

42
libgfortran/caf/single.c
View File

@ -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

2
libgfortran/libgfortran.h
View File

@ -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 */

2
libgfortran/runtime/pause.c
View File

@ -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");
}

53
libgfortran/runtime/stop.c
View File

@ -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);
}