diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c4cc44775e1..3b56c37d96f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2018-02-23 Janne Blomqvist + + 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 PR 78534 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e8c10d4d538..c233a0ee81f 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 f1fe8a0d9d1..cf76fd0162b 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 198a0e9efd3..dd97166952c 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 14c10b536e3..55d9908b8de 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 053ec87d562..1ad13bd5643 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 072dc869be8..ca06e6db620 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 3b4c17b8932..37672d4a02c 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 3ef1350c281..1e6dd8c28d0 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); }