PR 78534, 83704 Handle large formatted I/O

[gcc.git] / libgfortran / runtime / stop.c

diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 29f5031b3af5721bb866d0695a27ce64a52be7af..6f8b62f83857b675d166d8be78996b0daac9fc36 100644 (file)
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -1,8 +1,8 @@
 /* Implementation of the STOP statement.
-   Copyright 2002, 2005, 2007, 2009, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -24,37 +24,72 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
 #include "libgfortran.h"
-#include <string.h>
 
-/* A numeric STOP statement.  */
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
 
-extern void stop_numeric (GFC_INTEGER_4)
-  __attribute__ ((noreturn));
-export_proto(stop_numeric);
 
-void
-stop_numeric (GFC_INTEGER_4 code)
+/* Fortran 2008 demands: If any exception (14) is signaling on that image, the
+   processor shall issue a warning indicating which exceptions are signaling;
+   this warning shall be on the unit identified by the named constant
+   ERROR_UNIT (13.8.2.8).  In line with other compilers, we do not report
+   inexact - and we optionally ignore underflow, cf. thread starting at
+   http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html.  */
+
+static void
+report_exception (void)
 {
-  if (code == -1)
-    code = 0;
-  else
-    st_printf ("STOP %d\n", (int)code);
+  int set_excepts;
+
+  if (!compile_options.fpe_summary)
+    return;
+
+  set_excepts = get_fpu_except_flags ();
+  if ((set_excepts & compile_options.fpe_summary) == 0)
+    return;
+
+  estr_write ("Note: The following floating-point exceptions are signalling:");
+
+  if ((compile_options.fpe_summary & GFC_FPE_INVALID)
+      && (set_excepts & GFC_FPE_INVALID))
+    estr_write (" IEEE_INVALID_FLAG");
 
-  sys_exit (code);
+  if ((compile_options.fpe_summary & GFC_FPE_ZERO)
+      && (set_excepts & GFC_FPE_ZERO))
+    estr_write (" IEEE_DIVIDE_BY_ZERO");
+
+  if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
+      && (set_excepts & GFC_FPE_OVERFLOW))
+    estr_write (" IEEE_OVERFLOW_FLAG");
+
+  if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
+      && (set_excepts & GFC_FPE_UNDERFLOW))
+    estr_write (" IEEE_UNDERFLOW_FLAG");
+
+  if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
+      && (set_excepts & GFC_FPE_DENORMAL))
+    estr_write (" IEEE_DENORMAL");
+
+  if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
+      && (set_excepts & GFC_FPE_INEXACT))
+    estr_write (" IEEE_INEXACT_FLAG");
+
+  estr_write ("\n");
 }
 
 
-/* A Fortran 2008 numeric STOP statement.  */
+/* A numeric STOP statement.  */
 
-extern void stop_numeric_f08 (GFC_INTEGER_4)
-  __attribute__ ((noreturn));
-export_proto(stop_numeric_f08);
+extern _Noreturn void stop_numeric (GFC_INTEGER_4);
+export_proto(stop_numeric);
 
 void
-stop_numeric_f08 (GFC_INTEGER_4 code)
+stop_numeric (GFC_INTEGER_4 code)
 {
+  report_exception ();
   st_printf ("STOP %d\n", (int)code);
-  sys_exit (code);
+  exit (code);
 }
 
 
@@ -63,14 +98,14 @@ stop_numeric_f08 (GFC_INTEGER_4 code)
 void
 stop_string (const char *string, GFC_INTEGER_4 len)
 {
+  report_exception ();
   if (string)
     {
-      st_printf ("STOP ");
-      while (len--)
-       st_printf ("%c", *(string++));
-      st_printf ("\n");
+      estr_write ("STOP ");
+      (void) write (STDERR_FILENO, string, len);
+      estr_write ("\n");
     }
-  sys_exit (0);
+  exit (0);
 }
 
 
@@ -79,31 +114,30 @@ stop_string (const char *string, GFC_INTEGER_4 len)
    initiates error termination of execution."  Thus, error_stop_string returns
    a nonzero exit status code.  */
 
-extern void error_stop_string (const char *, GFC_INTEGER_4)
-  __attribute__ ((noreturn));
+extern _Noreturn void error_stop_string (const char *, GFC_INTEGER_4);
 export_proto(error_stop_string);
 
 void
 error_stop_string (const char *string, GFC_INTEGER_4 len)
 {
-  st_printf ("ERROR STOP ");
-  while (len--)
-    st_printf ("%c", *(string++));
-  st_printf ("\n");
+  report_exception ();
+  estr_write ("ERROR STOP ");
+  (void) write (STDERR_FILENO, string, len);
+  estr_write ("\n");
 
-  sys_exit (1);
+  exit_error (1);
 }
 
 
 /* A numeric ERROR STOP statement.  */
 
-extern void error_stop_numeric (GFC_INTEGER_4)
-  __attribute__ ((noreturn));
+extern _Noreturn void error_stop_numeric (GFC_INTEGER_4);
 export_proto(error_stop_numeric);
 
 void
 error_stop_numeric (GFC_INTEGER_4 code)
 {
+  report_exception ();
   st_printf ("ERROR STOP %d\n", (int) code);
-  sys_exit (code);
+  exit_error (code);
 }