gfortran.h (gfc_option_t): Add fpe_summary.

2013-06-17  Tobias Burnus  <burnus@net-b.de>

        * gfortran.h (gfc_option_t): Add fpe_summary.
        * gfortran.texi (_gfortran_set_options): Update.
        * invoke.texi (-ffpe-summary): Add doc.
        * lang.opt (ffpe-summary): Add flag.
        * options.c (gfc_init_options, gfc_handle_option): Handle it.
        (gfc_handle_fpe_option): Renamed from gfc_handle_fpe_trap_option,
        also handle fpe_summary.
        * trans-decl.c (create_main_function): Update
        _gfortran_set_options call.

2013-06-17  Tobias Burnus  <burnus@net-b.de>

        * libgfortran.h (compile_options_t) Add fpe_summary.
        (get_fpu_except_flags): New prototype.
        * runtime/compile_options.c (set_options, init_compile_options):
        Handle fpe_summary.
        * runtime/stop.c (report_exception): New function.
        (stop_numeric, stop_numeric_f08, stop_string, error_stop_string,
        error_stop_numeric): Call it.
        * config/fpu-387.h (get_fpu_except_flags): New function.
        * config/fpu-aix.h (get_fpu_except_flags): New function.
        * config/fpu-generic.h (get_fpu_except_flags): New function.
        * config/fpu-glibc.h (get_fpu_except_flags): New function.
        * config/fpu-glibc.h (get_fpu_except_flags): New function.
        * configure.ac: Check for fpxcp.h.
        * configure: Regenerate.
        * config.h.in: Regenerate.

From-SVN: r200147

1 files changed, 54 insertions, 0 deletions

diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 4805412..1091245 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -32,6 +32,55 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #endif
 
 
+/* 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)
+{
+  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");
+
+  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 numeric STOP statement.  */
 
 extern void stop_numeric (GFC_INTEGER_4)
@@ -41,6 +90,7 @@ export_proto(stop_numeric);
 void
 stop_numeric (GFC_INTEGER_4 code)
 {
+  report_exception ();
   if (code == -1)
     code = 0;
   else
@@ -59,6 +109,7 @@ export_proto(stop_numeric_f08);
 void
 stop_numeric_f08 (GFC_INTEGER_4 code)
 {
+  report_exception ();
   st_printf ("STOP %d\n", (int)code);
   exit (code);
 }
@@ -69,6 +120,7 @@ stop_numeric_f08 (GFC_INTEGER_4 code)
 void
 stop_string (const char *string, GFC_INTEGER_4 len)
 {
+  report_exception ();
   if (string)
     {
       estr_write ("STOP ");
@@ -91,6 +143,7 @@ export_proto(error_stop_string);
 void
 error_stop_string (const char *string, GFC_INTEGER_4 len)
 {
+  report_exception ();
   estr_write ("ERROR STOP ");
   (void) write (STDERR_FILENO, string, len);
   estr_write ("\n");
@@ -108,6 +161,7 @@ export_proto(error_stop_numeric);
 void
 error_stop_numeric (GFC_INTEGER_4 code)
 {
+  report_exception ();
   st_printf ("ERROR STOP %d\n", (int) code);
   exit (code);
 }