PR 48915 Abort handling

From-SVN: r173750

5 files changed, 126 insertions, 112 deletions

diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index aa77025..10917d3 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -214,7 +214,7 @@ show_backtrace (void)
 	    if (strncasecmp (func, "*_gfortran", 10) == 0
 		|| strncasecmp (func, "_gfortran", 9) == 0
 		|| strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
-		|| strcmp (func, "_gfortrani_handler") == 0)
+		|| strcmp (func, "_gfortrani_backtrace_handler") == 0)
 	      continue;
 
 	    if (local_strcasestr (str[i], "libgfortran.so") != NULL
@@ -334,5 +334,7 @@ fallback:
   /* Fallback to the glibc backtrace.  */
   estr_write ("\nBacktrace for this error:\n");
   dump_glibc_backtrace (depth, str);
+  return;
 #endif
+  estr_write ("\nBacktrace not yet available on this platform, sorry!\n");
 }
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index 62c401b..dc0da4b 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -33,49 +33,28 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 compile_options_t compile_options;
 
 
+volatile sig_atomic_t fatal_error_in_progress = 0;
+
 /* A signal handler to allow us to output a backtrace.  */
 void
-handler (int signum)
+backtrace_handler (int signum)
 {
-  const char * name = NULL, * desc = NULL;
-
-  switch (signum)
-    {
-#if defined(SIGSEGV)
-      case SIGSEGV:
-	name = "SIGSEGV";
-	desc = "Segmentation fault";
-	break;
-#endif
-
-#if defined(SIGBUS)
-      case SIGBUS:
-	name = "SIGBUS";
-	desc = "Bus error";
-	break;
-#endif
-
-#if defined(SIGILL)
-      case SIGILL:
-	name = "SIGILL";
-	desc = "Illegal instruction";
-	break;
-#endif
-
-#if defined(SIGFPE)
-      case SIGFPE:
-	name = "SIGFPE";
-	desc = "Floating-point exception";
-	break;
-#endif
-    }
-
-  if (name)
-    st_printf ("\nProgram received signal %d (%s): %s.\n", signum, name, desc);
-  else
-    st_printf ("\nProgram received signal %d.\n", signum);
-
-  sys_exit (5);
+  /* Since this handler is established for more than one kind of signal, 
+     it might still get invoked recursively by delivery of some other kind
+     of signal.  Use a static variable to keep track of that. */
+  if (fatal_error_in_progress)
+    raise (signum);
+  fatal_error_in_progress = 1;
+
+  show_backtrace();
+
+  /* Now reraise the signal.  We reactivate the signal's
+     default handling, which is to terminate the process.
+     We could just call exit or abort,
+     but reraising the signal sets the return status
+     from the process correctly. */
+  signal (signum, SIG_DFL);
+  raise (signum);
 }
 
 
@@ -92,8 +71,9 @@ set_options (int num, int options[])
     compile_options.allow_std = options[1];
   if (num >= 3)
     compile_options.pedantic = options[2];
-  if (num >= 4)
-    compile_options.dump_core = options[3];
+  /* options[3] is the removed -fdump-core option. It's place in the
+     options array is retained due to ABI compatibility. Remove when
+     bumping the library ABI.  */
   if (num >= 5)
     compile_options.backtrace = options[4];
   if (num >= 6)
@@ -103,26 +83,53 @@ set_options (int num, int options[])
   if (num >= 8)
     compile_options.range_check = options[7];
 
-  /* If backtrace is required, we set signal handlers on most common
-     signals.  */
-#if defined(HAVE_SIGNAL) && (defined(SIGSEGV) || defined(SIGBUS) \
-			     || defined(SIGILL) || defined(SIGFPE))
+  /* If backtrace is required, we set signal handlers on the POSIX
+     2001 signals with core action.  */
+#if defined(HAVE_SIGNAL) && (defined(SIGQUIT) || defined(SIGILL) \
+			     || defined(SIGABRT) || defined(SIGFPE) \
+			     || defined(SIGSEGV) || defined(SIGBUS) \
+			     || defined(SIGSYS) || defined(SIGTRAP) \
+			     || defined(SIGXCPU) || defined(SIGXFSZ))
   if (compile_options.backtrace)
     {
+#if defined(SIGQUIT)
+      signal (SIGQUIT, backtrace_handler);
+#endif
+
+#if defined(SIGILL)
+      signal (SIGILL, backtrace_handler);
+#endif
+
+#if defined(SIGABRT)
+      signal (SIGABRT, backtrace_handler);
+#endif
+
+#if defined(SIGFPE)
+      signal (SIGFPE, backtrace_handler);
+#endif
+
 #if defined(SIGSEGV)
-      signal (SIGSEGV, handler);
+      signal (SIGSEGV, backtrace_handler);
 #endif
 
 #if defined(SIGBUS)
-      signal (SIGBUS, handler);
+      signal (SIGBUS, backtrace_handler);
 #endif
 
-#if defined(SIGILL)
-      signal (SIGILL, handler);
+#if defined(SIGSYS)
+      signal (SIGSYS, backtrace_handler);
 #endif
 
-#if defined(SIGFPE)
-      signal (SIGFPE, handler);
+#if defined(SIGTRAP)
+      signal (SIGTRAP, backtrace_handler);
+#endif
+
+#if defined(SIGXCPU)
+      signal (SIGXCPU, backtrace_handler);
+#endif
+
+#if defined(SIGXFSZ)
+      signal (SIGXFSZ, backtrace_handler);
 #endif
     }
 #endif
@@ -140,7 +147,6 @@ init_compile_options (void)
     | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
     | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY;
   compile_options.pedantic = 0;
-  compile_options.dump_core = 0;
   compile_options.backtrace = 0;
   compile_options.sign_zero = 1;
   compile_options.range_check = 1;
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index 7695f0d..6bd8886 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -318,11 +318,6 @@ static variable variable_table[] = {
   {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string,
    "Set format for unformatted files", 0},
 
-  /* Behaviour when encoutering a runtime error.  */
-  {"GFORTRAN_ERROR_DUMPCORE", -1, &options.dump_core,
-    init_boolean, show_boolean,
-    "Dump a core file (if possible) on runtime error", -1},
-
   {"GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace,
     init_boolean, show_boolean,
     "Print out a backtrace (if possible) on runtime error", -1},
@@ -388,7 +383,7 @@ show_variables (void)
   estr_write ("\nCommand line arguments:\n");
   estr_write ("  --help               Print this list\n");
 
-  sys_exit (0);
+  exit (0);
 }
 
 /* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable.
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index e619044..dae298d 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -58,44 +58,32 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #endif
 
 
-/* sys_exit()-- Terminate the program with an exit code.  */
-
-void
-sys_exit (int code)
-{
-  /* Show error backtrace if possible.  */
-  if (code != 0 && code != 4
-      && (options.backtrace == 1
-	  || (options.backtrace == -1 && compile_options.backtrace == 1)))
-    show_backtrace ();
-
-  /* Dump core if requested.  */
-  if (code != 0
-      && (options.dump_core == 1
-	 || (options.dump_core == -1 && compile_options.dump_core == 1)))
-    {
-#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_CORE)
-      /* Warn if a core file cannot be produced because
-	 of core size limit.  */
-
-      struct rlimit core_limit;
-
-      if (getrlimit (RLIMIT_CORE, &core_limit) == 0 && core_limit.rlim_cur == 0)
-	estr_write ("** Warning: a core dump was requested, but the core size"
-		   "limit\n**          is currently zero.\n\n");
-#endif
-      
-      
-#if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT)
-      kill (getpid (), SIGQUIT);
-#else
-      estr_write ("Core dump not possible, sorry.");
-#endif
-    }
-
-  exit (code);
-}
-
+/* Termination of a program: F2008 2.3.5 talks about "normal
+   termination" and "error termination". Normal termination occurs as
+   a result of e.g. executing the end program statement, and executing
+   the STOP statement. It includes the effect of the C exit()
+   function. 
+
+   Error termination is initiated when the ERROR STOP statement is
+   executed, when ALLOCATE/DEALLOCATE fails without STAT= being
+   specified, when some of the co-array synchronization statements
+   fail without STAT= being specified, and some I/O errors if
+   ERR/IOSTAT/END/EOR is not present, and finally EXECUTE_COMMAND_LINE
+   failure without CMDSTAT=.
+
+   2.3.5 also explains how co-images synchronize during termination.
+
+   In libgfortran we have two ways of ending a program. exit(code) is
+   a normal exit; calling exit() also causes open units to be
+   closed. No backtrace or core dump is needed here. When something
+   goes wrong, we have sys_abort() which tries to print the backtrace
+   if -fbacktrace is enabled, and then dumps core; whether a core file
+   is generated is system dependent. When aborting, we don't flush and
+   close open units, as program memory might be corrupted and we'd
+   rather risk losing dirty data in the buffers rather than corrupting
+   files on disk.
+
+*/
 
 /* Error conditions.  The tricky part here is printing a message when
  * it is the I/O subsystem that is severely wounded.  Our goal is to
@@ -107,7 +95,6 @@ sys_exit (int code)
  * 1    Terminated because of operating system error.
  * 2    Error in the runtime library
  * 3    Internal error in runtime library
- * 4    Error during error processing (very bad)
  *
  * Other error returns are reserved for the STOP statement with a numeric code.
  */
@@ -150,7 +137,7 @@ st_vprintf (const char *format, va_list ap)
 #define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
       write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1);
       write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
-      sys_exit(2);
+      sys_abort ();
 #undef ERROR_MESSAGE
 
     }
@@ -173,6 +160,27 @@ st_printf (const char * format, ...)
 }
 
 
+/* sys_abort()-- Terminate the program showing backtrace and dumping
+   core.  */
+
+void
+sys_abort ()
+{
+  /* If backtracing is enabled, print backtrace and disable signal
+     handler for ABRT.  */
+  if (options.backtrace == 1
+      || (options.backtrace == -1 && compile_options.backtrace == 1))
+    {
+      show_backtrace ();
+#if defined(HAVE_SIGNAL) && defined(SIGABRT)
+      signal (SIGABRT, SIG_DFL);
+#endif
+    }
+
+  abort();
+}
+
+
 /* gfc_xtoa()-- Integer to hexadecimal conversion.  */
 
 const char *
@@ -278,7 +286,7 @@ recursion_check (void)
 
   /* Don't even try to print something at this point */
   if (magic == MAGIC)
-    sys_exit (4);
+    sys_abort ();
 
   magic = MAGIC;
 }
@@ -300,7 +308,7 @@ os_error (const char *message)
   estr_write ("\n");
   estr_write (message);
   estr_write ("\n");
-  sys_exit (1);
+  exit (1);
 }
 iexport(os_error);
 
@@ -319,7 +327,7 @@ runtime_error (const char *message, ...)
   st_vprintf (message, ap);
   va_end (ap);
   estr_write ("\n");
-  sys_exit (2);
+  exit (2);
 }
 iexport(runtime_error);
 
@@ -338,7 +346,7 @@ runtime_error_at (const char *where, const char *message, ...)
   st_vprintf (message, ap);
   va_end (ap);
   estr_write ("\n");
-  sys_exit (2);
+  exit (2);
 }
 iexport(runtime_error_at);
 
@@ -376,7 +384,7 @@ internal_error (st_parameter_common *cmp, const char *message)
      because hopefully it doesn't happen too often).  */
   stupid_function_name_for_static_linking();
 
-  sys_exit (3);
+  exit (3);
 }
 
 
@@ -544,7 +552,7 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
   estr_write ("Fortran runtime error: ");
   estr_write (message);
   estr_write ("\n");
-  sys_exit (2);
+  exit (2);
 }
 iexport(generate_error);
 
@@ -606,7 +614,7 @@ notify_std (st_parameter_common *cmp, int std, const char * message)
       estr_write ("Fortran runtime error: ");
       estr_write (message);
       estr_write ("\n");
-      sys_exit (2);
+      exit (2);
     }
   else
     {
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index b6f61ff..2efe239 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -41,7 +41,7 @@ stop_numeric (GFC_INTEGER_4 code)
   else
     st_printf ("STOP %d\n", (int)code);
 
-  sys_exit (code);
+  exit (code);
 }
 
 
@@ -55,7 +55,7 @@ void
 stop_numeric_f08 (GFC_INTEGER_4 code)
 {
   st_printf ("STOP %d\n", (int)code);
-  sys_exit (code);
+  exit (code);
 }
 
 
@@ -71,7 +71,7 @@ stop_string (const char *string, GFC_INTEGER_4 len)
       (void) sizeof (w); /* Avoid compiler warning about not using w.  */
       estr_write ("\n");
     }
-  sys_exit (0);
+  exit (0);
 }
 
 
@@ -92,7 +92,7 @@ error_stop_string (const char *string, GFC_INTEGER_4 len)
   (void) sizeof (w); /* Avoid compiler warning about not using w.  */
   estr_write ("\n");
 
-  sys_exit (1);
+  sys_abort ();
 }
 
 
@@ -106,5 +106,8 @@ void
 error_stop_numeric (GFC_INTEGER_4 code)
 {
   st_printf ("ERROR STOP %d\n", (int) code);
-  sys_exit (code);
+  if (options.backtrace == 1
+      || (options.backtrace == -1 && compile_options.backtrace == 1))
+    show_backtrace ();
+  exit (code);
 }