diff options
Diffstat (limited to 'libgfortran/runtime/stop.c')
| -rw-r--r-- | libgfortran/runtime/stop.c | 54 |
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); } |