re PR libfortran/29649 (Force core dump on runtime library errors)

2007-01-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
            Tobias Burnus  <burnus@net-b.de>

       PR libfortran/29649
       * gfortran.h (gfc_option_t): Add flag_dump_core.
       * lang.opt: Add -fdump-core option.
       * invoke.texi: Document the new options.
       * trans-decl.c (gfc_build_builtin_function_decls): Add new
         options to the call to set_std.
       * options.c (gfc_init_options, gfc_handle_option): Set the
         new options.

2007-01-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
            Tobias Burnus  <burnus@net-b.de>

       PR libfortran/29649
       * runtime/environ.c (variable_table): New GFORTRAN_ERROR_DUMPCORE
         environment variable.
       * runtime/compile_options.c (set_std): Add new argument.
       * runtime/error.c (sys_exit): Move from io/unix.c. Add coredump functionality.
       * libgfortran.h (options_t): New dump_core and backtrace members.
         (sys_exit): Move prototype.
       * io/unix.c (sys_exit): Move to runtime/error.c.
       * configure.ac: Add check for getrlimit.
       * configure: Regenerate.


Co-Authored-By: Tobias Burnus <burnus@net-b.de>

From-SVN: r120897

8 files changed, 91 insertions, 16 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 2efc5ce..5295968 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,17 @@
+2007-01-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR libfortran/29649
+	* runtime/environ.c (variable_table): New GFORTRAN_ERROR_DUMPCORE
+	  environment variable.
+	* runtime/compile_options.c (set_std): Add new argument.
+	* runtime/error.c (sys_exit): Move from io/unix.c. Add coredump functionality.
+	* libgfortran.h (options_t): New dump_core and backtrace members.
+	  (sys_exit): Move prototype.
+	* io/unix.c (sys_exit): Move to runtime/error.c.
+	* configure.ac: Add check for getrlimit.
+	* configure: Regenerate.
+
 2007-01-17  Tom Tromey  <tromey@redhat.com>
 
 	PR libgfortran/27107:
diff --git a/libgfortran/configure b/libgfortran/configure
index 5ee295a..30b3eb2 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -10270,7 +10270,8 @@ done
 
 
 
-for ac_func in wait setmode
+
+for ac_func in wait setmode getrlimit
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index a4a9b39..d97360f 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -171,7 +171,7 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
 AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
 AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
 AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
-AC_CHECK_FUNCS(wait setmode)
+AC_CHECK_FUNCS(wait setmode getrlimit)
 
 # Check for types
 AC_CHECK_TYPES([intptr_t])
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index aa1dd1f..08f32878 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -363,15 +363,6 @@ get_oserror (void)
 }
 
 
-/* sys_exit()-- Terminate the program with an exit code */
-
-void
-sys_exit (int code)
-{
-  exit (code);
-}
-
-
 /*********************************************************************
     File descriptor stream functions
 *********************************************************************/
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index dc93b2f..af53e480 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -355,6 +355,7 @@ typedef struct
   int fpu_round, fpu_precision, fpe;
 
   int sighup, sigint;
+  int dump_core;
 }
 options_t;
 
@@ -370,6 +371,7 @@ typedef struct
   int allow_std;
   int pedantic;
   int convert;
+  int dump_core;
   size_t record_marker;
   int max_subrecord_length;
 }
@@ -549,6 +551,9 @@ internal_proto(get_args);
 #define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
 #define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1)
 
+extern void sys_exit (int) __attribute__ ((noreturn));
+internal_proto(sys_exit);
+
 extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t);
 internal_proto(gfc_itoa);
 
@@ -571,9 +576,6 @@ internal_proto(internal_error);
 extern const char *get_oserror (void);
 internal_proto(get_oserror);
 
-extern void sys_exit (int) __attribute__ ((noreturn));
-internal_proto(sys_exit);
-
 extern void st_sprintf (char *, const char *, ...)
   __attribute__ ((format (printf, 2, 3)));
 internal_proto(st_sprintf);
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index b2aef05..06ebc4d 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -37,17 +37,19 @@ compile_options_t compile_options;
 
 
 /* Prototypes */
-extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4);
+extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4,
+		     GFC_INTEGER_4);
 export_proto(set_std);
 
 
 void
 set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std,
-	 GFC_INTEGER_4 pedantic)
+	 GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core)
 {
   compile_options.pedantic = pedantic;
   compile_options.warn_std = warn_std;
   compile_options.allow_std = allow_std;
+  compile_options.dump_core = dump_core;
 }
 
 
@@ -61,6 +63,7 @@ init_compile_options (void)
   compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
     | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
   compile_options.pedantic = 0;
+  compile_options.dump_core = 0;
 }
 
 /* Function called by the front-end to tell us the
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index 21c2cc9..cc3be21 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -537,6 +537,11 @@ 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},
+
   {NULL, 0, NULL, NULL, NULL, NULL, 0}
 };
 
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index c0787de..e6713d2 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -36,8 +36,67 @@ Boston, MA 02110-1301, USA.  */
 #include <float.h>
 #include <errno.h>
 
+#ifdef HAVE_SIGNAL_H
+#include <signal.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif
+
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#endif
+
 #include "libgfortran.h"
 
+#ifdef __MINGW32__
+#define HAVE_GETPID 1
+#include <process.h>
+#endif
+
+
+/* sys_exit()-- Terminate the program with an exit code.  */
+
+void
+sys_exit (int code)
+{
+  /* 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)
+	st_printf ("** 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
+      st_printf ("Core dump not possible, sorry.");
+#endif
+    }
+
+  exit (code);
+}
+
+
 /* 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
  * try and print something making the fewest assumptions possible,