aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/trans-decl.c10
-rw-r--r--gcc/fortran/trans-stmt.c13
-rw-r--r--libgfortran/caf/libcaf.h8
-rw-r--r--libgfortran/caf/mpi.c19
-rw-r--r--libgfortran/caf/single.c42
-rw-r--r--libgfortran/libgfortran.h2
-rw-r--r--libgfortran/runtime/pause.c2
-rw-r--r--libgfortran/runtime/stop.c53
9 files changed, 95 insertions, 62 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c4cc447..3b56c37 100644
--- 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 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);
}
generated by cgit v1.1 at 2025-05-21 05:22:59 +0000