===================================================================
@@ -600,18 +600,24 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, 0);
- tmp = build_call_expr_loc (input_location,
- error_stop ? gfor_fndecl_error_stop_string
- : gfor_fndecl_stop_string,
- 2, build_int_cst (pchar_type_node, 0), tmp);
+ if (error_stop)
+ {
+ tmp = build_int_cst (gfc_int4_type_node, 0);
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_error_stop_string,
+ 2, build_int_cst (pchar_type_node, 0),
+ tmp);
+ }
+ else
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_stop_empty, 0);
}
else if (code->expr1->ts.type == BT_INTEGER)
{
gfc_conv_expr (&se, code->expr1);
tmp = build_call_expr_loc (input_location,
- error_stop ? gfor_fndecl_error_stop_numeric
- : gfor_fndecl_stop_numeric, 1,
+ error_stop ? gfor_fndecl_error_stop_string
+ : gfor_fndecl_stop_string, 2,
+ build_int_cst (pchar_type_node, 0),
fold_convert (gfc_int4_type_node, se.expr));
}
else
===================================================================
@@ -588,6 +588,7 @@ void gfc_omp_firstprivatize_type_sizes (struct gim
/* Runtime library function decls. */
extern GTY(()) tree gfor_fndecl_pause_numeric;
extern GTY(()) tree gfor_fndecl_pause_string;
+extern GTY(()) tree gfor_fndecl_stop_empty;
extern GTY(()) tree gfor_fndecl_stop_numeric;
extern GTY(()) tree gfor_fndecl_stop_string;
extern GTY(()) tree gfor_fndecl_error_stop_numeric;
===================================================================
@@ -86,6 +86,7 @@ tree gfc_static_ctors;
tree gfor_fndecl_pause_numeric;
tree gfor_fndecl_pause_string;
+tree gfor_fndecl_stop_empty;
tree gfor_fndecl_stop_numeric;
tree gfor_fndecl_stop_string;
tree gfor_fndecl_error_stop_numeric;
@@ -2796,6 +2797,12 @@ gfc_build_builtin_function_decls (void)
{
tree gfc_int4_type_node = gfc_get_int_type (4);
+ gfor_fndecl_stop_empty = gfc_build_library_function_decl (
+ get_identifier (PREFIX("stop_empty")),
+ void_type_node, 1, void_type_node);
+ /* STOP doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_stop_empty) = 1;
+
gfor_fndecl_stop_numeric = gfc_build_library_function_decl (
get_identifier (PREFIX("stop_numeric")),
void_type_node, 1, gfc_int4_type_node);
===================================================================
@@ -26,6 +26,18 @@ see the files COPYING3 and COPYING.RUNTIME respect
#include "libgfortran.h"
#include <string.h>
+/* An empty STOP statement. */
+
+extern void stop_empty (void)
+ __attribute__ ((noreturn));
+export_proto(stop_empty);
+
+void
+stop_empty (void)
+{
+ sys_exit (0);
+}
+
/* A numeric STOP statement. */
extern void stop_numeric (GFC_INTEGER_4)
@@ -35,7 +47,11 @@ export_proto(stop_numeric);
void
stop_numeric (GFC_INTEGER_4 code)
{
- st_printf ("STOP %d\n", (int)code);
+ if (code == -1)
+ code = 0;
+ else
+ st_printf ("STOP %d\n", (int)code);
+
sys_exit (code);
}
@@ -44,13 +60,17 @@ stop_numeric (GFC_INTEGER_4 code)
void
stop_string (const char *string, GFC_INTEGER_4 len)
{
+ st_printf ("STOP ");
+
if (string)
{
- st_printf ("STOP ");
while (len--)
st_printf ("%c", *(string++));
- st_printf ("\n");
}
+ else
+ st_printf ("%d", (int)len);
+
+ st_printf ("\n");
sys_exit (0);
}
@@ -68,10 +88,15 @@ void
error_stop_string (const char *string, GFC_INTEGER_4 len)
{
st_printf ("ERROR STOP ");
- while (len--)
- st_printf ("%c", *(string++));
+ if (string)
+ {
+ while (len--)
+ st_printf ("%c", *(string++));
+ }
+ else
+ st_printf ("%d", (int)len);
+
st_printf ("\n");
-
sys_exit (1);
}
===================================================================
@@ -1141,6 +1141,7 @@ GFORTRAN_1.4 {
_gfortran_parity_l8;
_gfortran_parity_l16;
_gfortran_selected_real_kind2008;
+ _gfortran_stop_empty;
_gfortran_transfer_array_write;
_gfortran_transfer_character_write;
_gfortran_transfer_character_wide_write;