OSDN Git Service

* gfortran.h (gfc_option_t): Add flag_backtrace field.
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 15 Mar 2007 12:39:47 +0000 (12:39 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 15 Mar 2007 12:39:47 +0000 (12:39 +0000)
* lang.opt: Add -fbacktrace option.
* invoke.texi: Document the new option.
* trans-decl.c (gfc_build_builtin_function_decls): Add new
option to the call to set_std.
* options.c (gfc_init_options, gfc_handle_option): Handle the
new option.

* runtime/backtrace.c: New file.
* runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE
environment variable.
* runtime/compile_options.c (set_std): Add new argument.
* runtime/main.c (store_exe_path, full_exe_path): New functions.
* runtime/error.c (sys_exit): Add call to show_backtrace.
* libgfortran.h (options_t): New backtrace field.
(store_exe_path, full_exe_path, show_backtrace): New prototypes.
* configure.ac: Add checks for execinfo.h, execvp, pipe, dup2,
close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols
and getppid.
* Makefile.am: Add runtime/backtrace.c.
* fmain.c (main): Add call to store_exe_path.
* Makefile.in: Renegerate.
* config.h.in: Renegerate.
* configure: Regenerate.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@122954 138bc75d-0d04-0410-961f-82ee72b054a4

19 files changed:
gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/invoke.texi
gcc/fortran/lang.opt
gcc/fortran/options.c
gcc/fortran/trans-decl.c
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/config.h.in
libgfortran/configure
libgfortran/configure.ac
libgfortran/fmain.c
libgfortran/libgfortran.h
libgfortran/runtime/backtrace.c [new file with mode: 0644]
libgfortran/runtime/compile_options.c
libgfortran/runtime/environ.c
libgfortran/runtime/error.c
libgfortran/runtime/main.c

index 449f9b8..a738975 100644 (file)
@@ -1,3 +1,13 @@
+2007-03-15  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       * gfortran.h (gfc_option_t): Add flag_backtrace field.
+       * lang.opt: Add -fbacktrace option.
+       * invoke.texi: Document the new option.
+       * trans-decl.c (gfc_build_builtin_function_decls): Add new
+       option to the call to set_std.
+       * options.c (gfc_init_options, gfc_handle_option): Handle the
+       new option.
+
 2007-03-15  Tobias Burnus  <burnus@gcc.gnu.org>
            Paul Thomas  <pault@gcc.gnu.org>
 
index 52553a4..b806f18 100644 (file)
@@ -1659,6 +1659,7 @@ typedef struct
   int flag_f2c;
   int flag_automatic;
   int flag_backslash;
+  int flag_backtrace;
   int flag_allow_leading_underscore;
   int flag_dump_core;
   int flag_external_blas;
index c4d0902..ef9825c 100644 (file)
@@ -134,8 +134,8 @@ and Warnings}.
 
 @item Debugging Options
 @xref{Debugging Options,,Options for Debugging Your Program or GCC}.
-@gccoptlist{-fdump-parse-tree  -ffpe-trap=@var{list}
--fdump-core}
+@gccoptlist{-fdump-parse-tree  -ffpe-trap=@var{list} @gol
+-fdump-core -fbacktrace}
 
 @item Directory Options
 @xref{Directory Options,,Options for Directory Search}.
@@ -562,6 +562,15 @@ zero), @samp{overflow} (overflow in a floating point operation),
 @samp{precision} (loss of precision during operation) and @samp{denormal}
 (operation produced a denormal value).
 
+@cindex -fbacktrace option
+@cindex options, -fbacktrace
+@item -fbacktrace
+@cindex backtrace
+@cindex trace
+Specify that, when a runtime error is encountered, the Fortran runtime
+library should output a backtrace of the error.  This option
+only has influence for compilation of the Fortran main program.
+
 @cindex -fdump-core option
 @cindex options, -fdump-core
 @item -fdump-core
index b1d5f22..c1697fc 100644 (file)
@@ -93,6 +93,10 @@ fbackslash
 Fortran
 Specify that backslash in string introduces an escape character
 
+fbacktrace
+Fortran
+Produce a backtrace when a runtime error is encountered
+
 fblas-matmul-limit=
 Fortran RejectNegative Joined UInteger
 -fblas-matmul-limit=<n>        Size of the smallest matrix for which matmul will use BLAS
index e4f6092..96bedab 100644 (file)
@@ -94,6 +94,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
   gfc_option.flag_preprocessed = 0;
   gfc_option.flag_automatic = 1;
   gfc_option.flag_backslash = 1;
+  gfc_option.flag_backtrace = 0;
   gfc_option.flag_allow_leading_underscore = 0;
   gfc_option.flag_dump_core = 0;
   gfc_option.flag_external_blas = 0;
@@ -474,6 +475,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       gfc_option.flag_backslash = value;
       break;
       
+    case OPT_fbacktrace:
+      gfc_option.flag_backtrace = value;
+      break;
+      
     case OPT_fdump_core:
       gfc_option.flag_dump_core = value;
       break;
index 862958a..a98b11c 100644 (file)
@@ -2378,7 +2378,8 @@ gfc_build_builtin_function_decls (void)
   gfor_fndecl_set_std =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
                                    void_type_node,
-                                   4,
+                                   5,
+                                   gfc_int4_type_node,
                                    gfc_int4_type_node,
                                    gfc_int4_type_node,
                                    gfc_int4_type_node,
@@ -3144,7 +3145,9 @@ gfc_generate_function_code (gfc_namespace * ns)
                             build_int_cst (gfc_int4_type_node,
                                            pedantic),
                             build_int_cst (gfc_int4_type_node,
-                                           gfc_option.flag_dump_core));
+                                           gfc_option.flag_dump_core),
+                            build_int_cst (gfc_int4_type_node,
+                                           gfc_option.flag_backtrace));
       gfc_add_expr_to_block (&body, tmp);
     }
 
index d793b72..70cdf75 100644 (file)
@@ -1,3 +1,22 @@
+2007-03-15  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       * runtime/backtrace.c: New file.
+       * runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE
+       environment variable.
+       * runtime/compile_options.c (set_std): Add new argument.
+       * runtime/main.c (store_exe_path, full_exe_path): New functions.
+       * runtime/error.c (sys_exit): Add call to show_backtrace.
+       * libgfortran.h (options_t): New backtrace field.
+       (store_exe_path, full_exe_path, show_backtrace): New prototypes.
+       * configure.ac: Add checks for execinfo.h, execvp, pipe, dup2,
+       close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols
+       and getppid.
+       * Makefile.am: Add runtime/backtrace.c.
+       * fmain.c (main): Add call to store_exe_path.
+       * Makefile.in: Renegerate.
+       * config.h.in: Renegerate.
+       * configure: Regenerate.
+
 2007-03-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/31051
index f306cc9..2338b9b 100644 (file)
@@ -97,6 +97,7 @@ runtime/in_pack_generic.c \
 runtime/in_unpack_generic.c
 
 gfor_src= \
+runtime/backtrace.c \
 runtime/compile_options.c \
 runtime/environ.c \
 runtime/error.c \
index c1ff053..8e10976 100644 (file)
@@ -71,8 +71,8 @@ myexeclibLTLIBRARIES_INSTALL = $(INSTALL)
 toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
 LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
 libgfortran_la_LIBADD =
-am__objects_1 = compile_options.lo environ.lo error.lo fpu.lo main.lo \
-       memory.lo pause.lo stop.lo string.lo select.lo
+am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \
+       fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo
 am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
 am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
 am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
@@ -476,6 +476,7 @@ runtime/in_pack_generic.c \
 runtime/in_unpack_generic.c
 
 gfor_src = \
+runtime/backtrace.c \
 runtime/compile_options.c \
 runtime/environ.c \
 runtime/error.c \
@@ -1141,6 +1142,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@
@@ -1942,6 +1944,13 @@ f2c_specifics.lo: intrinsics/f2c_specifics.F90
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LTCOMPILE) -c -o $@ $<
 
+backtrace.lo: runtime/backtrace.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT backtrace.lo -MD -MP -MF "$(DEPDIR)/backtrace.Tpo" -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/backtrace.Tpo" "$(DEPDIR)/backtrace.Plo"; else rm -f "$(DEPDIR)/backtrace.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='runtime/backtrace.c' object='backtrace.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c
+
 compile_options.lo: runtime/compile_options.c
 @am__fastdepCC_TRUE@   if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF "$(DEPDIR)/compile_options.Tpo" -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c; \
 @am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/compile_options.Tpo" "$(DEPDIR)/compile_options.Plo"; else rm -f "$(DEPDIR)/compile_options.Tpo"; exit 1; fi
index ab7a892..216adba 100644 (file)
 /* Define to 1 if the target supports __attribute__((visibility(...))). */
 #undef HAVE_ATTRIBUTE_VISIBILITY
 
+/* Define to 1 if you have the `backtrace' function. */
+#undef HAVE_BACKTRACE
+
+/* Define to 1 if you have the `backtrace_symbols' function. */
+#undef HAVE_BACKTRACE_SYMBOLS
+
 /* Define if fpclassify is broken. */
 #undef HAVE_BROKEN_FPCLASSIFY
 
 /* libm includes clogl */
 #undef HAVE_CLOGL
 
+/* Define to 1 if you have the `close' function. */
+#undef HAVE_CLOSE
+
 /* complex.h exists */
 #undef HAVE_COMPLEX_H
 
 /* Define to 1 if you have the `ctime' function. */
 #undef HAVE_CTIME
 
+/* Define to 1 if you have the `dup2' function. */
+#undef HAVE_DUP2
+
 /* libm includes erf */
 #undef HAVE_ERF
 
 /* libm includes erfl */
 #undef HAVE_ERFL
 
+/* Define to 1 if you have the <execinfo.h> header file. */
+#undef HAVE_EXECINFO_H
+
 /* Define to 1 if you have the `execl' function. */
 #undef HAVE_EXECL
 
+/* Define to 1 if you have the `execvp' function. */
+#undef HAVE_EXECVP
+
 /* libm includes exp */
 #undef HAVE_EXP
 
 /* libm includes fabsl */
 #undef HAVE_FABSL
 
+/* Define to 1 if you have the `fdopen' function. */
+#undef HAVE_FDOPEN
+
 /* libm includes feenableexcept */
 #undef HAVE_FEENABLEEXCEPT
 
 /* libc includes getpid */
 #undef HAVE_GETPID
 
+/* libc includes getppid */
+#undef HAVE_GETPPID
+
 /* Define to 1 if you have the `getrlimit' function. */
 #undef HAVE_GETRLIMIT
 
 /* Define to 1 if you have the `getrusage' function. */
 #undef HAVE_GETRUSAGE
 
-/* Define to 1 if you have the `gettimeofday' function. */
-#undef HAVE_GETTIMEOFDAY
-
 /* libc includes getuid */
 #undef HAVE_GETUID
 
 /* Define to 1 if you have the `perror' function. */
 #undef HAVE_PERROR
 
+/* Define to 1 if you have the `pipe' function. */
+#undef HAVE_PIPE
+
 /* libm includes pow */
 #undef HAVE_POW
 
 /* Define to 1 if you have the <stdlib.h> header file. */
 #undef HAVE_STDLIB_H
 
+/* Define to 1 if you have the `strcasestr' function. */
+#undef HAVE_STRCASESTR
+
 /* Define to 1 if you have the `strerror' function. */
 #undef HAVE_STRERROR
 
index 5939bb3..3ef0bed 100755 (executable)
@@ -6575,7 +6575,8 @@ done
 
 
 
-for ac_header in fenv.h fptrap.h float.h
+
+for ac_header in fenv.h fptrap.h float.h execinfo.h
 do
 as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
 if eval "test \"\${$as_ac_Header+set}\" = set"; then
@@ -10398,7 +10399,122 @@ done
 
 
 
-for ac_func in wait setmode getrlimit gettimeofday
+
+
+
+
+
+for ac_func in wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+        { ac_try='test -z "$ac_c_werror_flag"
+                        || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+        { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+# Check for glibc backtrace functions
+
+
+for ac_func in backtrace backtrace_symbols
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5
@@ -10727,6 +10843,83 @@ _ACEOF
 
 fi
 
+echo "$as_me:$LINENO: checking for getppid in -lc" >&5
+echo $ECHO_N "checking for getppid in -lc... $ECHO_C" >&6
+if test "${ac_cv_lib_c_getppid+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char getppid ();
+int
+main ()
+{
+getppid ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+        { ac_try='test -z "$ac_c_werror_flag"
+                        || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+        { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_c_getppid=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_c_getppid=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_c_getppid" >&5
+echo "${ECHO_T}$ac_cv_lib_c_getppid" >&6
+if test $ac_cv_lib_c_getppid = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_GETPPID 1
+_ACEOF
+
+fi
+
 echo "$as_me:$LINENO: checking for getuid in -lc" >&5
 echo $ECHO_N "checking for getuid in -lc... $ECHO_C" >&6
 if test "${ac_cv_lib_c_getuid+set}" = set; then
index 8711134..256a631 100644 (file)
@@ -164,7 +164,7 @@ AC_HEADER_TIME
 AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
 AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
 AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h)
-AC_CHECK_HEADERS(fenv.h fptrap.h float.h)
+AC_CHECK_HEADERS(fenv.h fptrap.h float.h execinfo.h)
 AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
 GCC_HEADER_STDINT(gstdint.h)
 
@@ -176,7 +176,10 @@ 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 getrlimit gettimeofday)
+AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
+
+# Check for glibc backtrace functions
+AC_CHECK_FUNCS(backtrace backtrace_symbols)
 
 # Check for types
 AC_CHECK_TYPES([intptr_t])
@@ -184,6 +187,7 @@ AC_CHECK_TYPES([intptr_t])
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
 AC_CHECK_LIB([c],[getpid],[AC_DEFINE([HAVE_GETPID],[1],[libc includes getpid])])
+AC_CHECK_LIB([c],[getppid],[AC_DEFINE([HAVE_GETPPID],[1],[libc includes getppid])])
 AC_CHECK_LIB([c],[getuid],[AC_DEFINE([HAVE_GETUID],[1],[libc includes getuid])])
 
 # Check for C99 (and other IEEE) math functions
index ec62125..397f17b 100644 (file)
@@ -10,9 +10,13 @@ void MAIN__ (void);
 int
 main (int argc, char *argv[])
 {
+  /* Store the path of the executable file.  */
+  store_exe_path (argv[0]);
+
   /* Set up the runtime environment.  */
   set_args (argc, argv);
 
+
   /* Call the Fortran main program.  Internally this is a function
      called MAIN__ */
   MAIN__ ();
index 80698e9..3703949 100644 (file)
@@ -361,7 +361,7 @@ typedef struct
   int fpu_round, fpu_precision, fpe;
 
   int sighup, sigint;
-  int dump_core;
+  int dump_core, backtrace;
 }
 options_t;
 
@@ -378,6 +378,7 @@ typedef struct
   int pedantic;
   int convert;
   int dump_core;
+  int backtrace;
   size_t record_marker;
   int max_subrecord_length;
 }
@@ -550,6 +551,17 @@ export_proto(set_args);
 extern void get_args (int *, char ***);
 internal_proto(get_args);
 
+extern void store_exe_path (const char *);
+export_proto(store_exe_path);
+
+extern char * full_exe_path (void);
+internal_proto(full_exe_path);
+
+/* backtrace.c */
+
+extern void show_backtrace (void);
+internal_proto(show_backtrace);
+
 /* error.c */
 
 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
new file mode 100644 (file)
index 0000000..3b17a39
--- /dev/null
@@ -0,0 +1,333 @@
+/* Copyright (C) 2006 Free Software Foundation, Inc.
+   Contributed by Fran├žois-Xavier Coudert
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with libgfortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+
+#include "config.h"
+#include <stdio.h>
+#include <string.h>
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef HAVE_INTTYPES_H
+#include <inttypes.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef HAVE_INTPTR_T
+# define INTPTR_T intptr_t
+#else
+# define INTPTR_T int
+#endif
+
+#ifdef HAVE_EXECINFO_H
+#include <execinfo.h>
+#endif
+
+#ifdef HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
+#include <ctype.h>
+
+#include "libgfortran.h"
+
+
+
+#ifndef HAVE_STRCASESTR
+#define HAVE_STRCASESTR 1
+static char *
+strcasestr (const char *s1, const char *s2)
+{
+  const char *p = s1;
+  const size_t len = strlen (s2);
+  const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
+                                 : (islower((int) *s2) ? toupper((int) *s2)
+                                                       : *s2);
+
+  while (1)
+    {
+      while (*p != u && *p != v && *p)
+       p++;
+      if (*p == 0)
+       return NULL;
+      if (strncasecmp (p, s2, len) == 0)
+       return (char *)p;
+    }
+}
+#endif
+
+#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
+                 && defined(HAVE_WAIT))
+#define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
+                        && defined(HAVE_BACKTRACE_SYMBOLS))
+#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
+                 && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
+                 && defined(HAVE_CLOSE))
+
+
+#if GLIBC_BACKTRACE
+static void
+dump_glibc_backtrace (int depth, char *str[])
+{
+  int i;
+
+  for (i = 0; i < depth; i++)
+    st_printf ("  + %s\n", str[i]);
+
+  free (str);
+}
+#endif
+
+/* show_backtrace displays the backtrace, currently obtained by means of
+   the glibc backtrace* functions.  */
+void
+show_backtrace (void)
+{
+#if GLIBC_BACKTRACE
+
+#define DEPTH 50
+#define BUFSIZE 1024
+
+  void *trace[DEPTH];
+  char **str;
+  int depth;
+
+  depth = backtrace (trace, DEPTH);
+  if (depth <= 0)
+    return;
+
+  str = backtrace_symbols (trace, depth);
+
+#if CAN_PIPE
+
+#ifndef STDIN_FILENO
+#define STDIN_FILENO 0
+#endif
+
+#ifndef STDOUT_FILENO
+#define STDOUT_FILENO 1
+#endif
+
+#ifndef STDERR_FILENO
+#define STDERR_FILENO 2
+#endif
+
+  /* We attempt to extract file and line information from addr2line.  */
+  do
+  {
+    /* Local variables.  */
+    int f[2], pid, line, i;
+    FILE *output;
+    char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
+    char *p, *end;
+    const char *addr[DEPTH];
+
+    /* Write the list of addresses in hexadecimal format.  */
+    for (i = 0; i < depth; i++)
+      addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (INTPTR_T) trace[i], addr_buf[i],
+                     sizeof (addr_buf[i]));
+
+    /* Don't output an error message if something goes wrong, we'll simply
+       fall back to the pstack and glibc backtraces.  */
+    if (pipe (f) != 0)
+      break;
+    if ((pid = fork ()) == -1)
+      break;
+
+    if (pid == 0)
+      {
+       /* Child process.  */
+#define NUM_FIXEDARGS 5
+       char *arg[DEPTH+NUM_FIXEDARGS+1];
+
+       close (f[0]);
+       close (STDIN_FILENO);
+       close (STDERR_FILENO);
+
+       if (dup2 (f[1], STDOUT_FILENO) == -1)
+         _exit (0);
+       close (f[1]);
+
+       arg[0] = (char *) "addr2line";
+       arg[1] = (char *) "-e";
+       arg[2] = full_exe_path ();
+       arg[3] = (char *) "-f";
+       arg[4] = (char *) "-s";
+       for (i = 0; i < depth; i++)
+         arg[NUM_FIXEDARGS+i] = (char *) addr[i];
+       arg[NUM_FIXEDARGS+depth] = NULL;
+       execvp (arg[0], arg);
+       _exit (0);
+#undef NUM_FIXEDARGS
+      }
+
+    /* Father process.  */
+    close (f[1]);
+    wait (NULL);
+    output = fdopen (f[0], "r");
+    i = -1;
+
+    if (fgets (func, sizeof(func), output))
+      {
+       st_printf ("\nBacktrace for this error:\n");
+
+       do
+         {
+           if (! fgets (file, sizeof(file), output))
+             goto fallback;
+
+           i++;
+
+           for (p = func; *p != '\n' && *p != '\r'; p++)
+             ;
+
+           *p = '\0';
+
+           /* Try to recognize the internal libgfortran functions.  */
+           if (strncasecmp (func, "*_gfortran", 10) == 0
+               || strncasecmp (func, "_gfortran", 9) == 0
+               || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0)
+             continue;
+
+           if (strcasestr (str[i], "libgfortran.so") != NULL
+               || strcasestr (str[i], "libgfortran.dylib") != NULL
+               || strcasestr (str[i], "libgfortran.a") != NULL)
+             continue;
+
+           /* If we only have the address, use the glibc backtrace.  */
+           if (func[0] == '?' && func[1] == '?' && file[0] == '?'
+               && file[1] == '?')
+             {
+               st_printf ("  + %s\n", str[i]);
+               continue;
+             }
+
+           /* Extract the line number.  */
+           for (end = NULL, p = file; *p; p++)
+             if (*p == ':')
+               end = p;
+           if (end != NULL)
+             {
+               *end = '\0';
+               line = atoi (++end);
+             }
+           else
+             line = -1;
+
+           if (strcmp (func, "MAIN__") == 0)
+             st_printf ("  + in the main program\n");
+           else
+             st_printf ("  + function %s (0x%s)\n", func, addr[i]);
+
+           if (line <= 0 && strcmp (file, "??") == 0)
+             continue;
+
+           if (line <= 0)
+             st_printf ("    from file %s\n", file);
+           else
+             st_printf ("    at line %d of file %s\n", line, file);
+         }
+       while (fgets (func, sizeof(func), output));
+
+       free (str);
+       return;
+
+fallback:
+       st_printf ("** Something went wrong while running addr2line. **\n"
+                  "** Falling back  to a simpler  backtrace scheme. **\n");
+      }
+    }
+  while (0);
+
+#undef DEPTH
+#undef BUFSIZE
+
+#endif
+#endif
+
+#if CAN_FORK && defined(HAVE_GETPPID)
+  /* Try to call pstack.  */
+  do
+  {
+    /* Local variables.  */
+    int pid;
+
+    /* Don't output an error message if something goes wrong, we'll simply
+       fall back to the pstack and glibc backtraces.  */
+    if ((pid = fork ()) == -1)
+      break;
+
+    if (pid == 0)
+      {
+       /* Child process.  */
+#define NUM_ARGS 2
+       char *arg[NUM_ARGS+1];
+       char buf[20];
+
+       st_printf ("\nBacktrace for this error:\n");
+       arg[0] = (char *) "pstack";
+       snprintf (buf, sizeof(buf), "%d", (int) getppid ());
+       arg[1] = buf;
+       arg[2] = NULL;
+       execvp (arg[0], arg);
+#undef NUM_ARGS
+
+       /* pstack didn't work, so we fall back to dumping the glibc
+          backtrace if we can.  */
+#if GLIBC_BACKTRACE
+       dump_glibc_backtrace (depth, str);
+#else
+       st_printf ("  unable to produce a backtrace, sorry!\n");
+#endif
+
+       _exit (0);
+      }
+
+    /* Father process.  */
+    wait (NULL);
+    return;
+  }
+  while(0);
+#endif
+
+#if GLIBC_BACKTRACE
+  /* Fallback to the glibc backtrace.  */
+  st_printf ("\nBacktrace for this error:\n");
+  dump_glibc_backtrace (depth, str);
+#endif
+}
index 06ebc4d..dc404da 100644 (file)
@@ -38,18 +38,20 @@ compile_options_t compile_options;
 
 /* Prototypes */
 extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, 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 dump_core)
+        GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core,
+        GFC_INTEGER_4 backtrace)
 {
   compile_options.pedantic = pedantic;
   compile_options.warn_std = warn_std;
   compile_options.allow_std = allow_std;
   compile_options.dump_core = dump_core;
+  compile_options.backtrace = backtrace;
 }
 
 
@@ -64,6 +66,7 @@ init_compile_options (void)
     | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
   compile_options.pedantic = 0;
   compile_options.dump_core = 0;
+  compile_options.backtrace = 0;
 }
 
 /* Function called by the front-end to tell us the
index cc3be21..c9c1e27 100644 (file)
@@ -542,6 +542,10 @@ static variable variable_table[] = {
     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},
+
   {NULL, 0, NULL, NULL, NULL, NULL, 0}
 };
 
index afd6a21..93b81c1 100644 (file)
@@ -71,6 +71,12 @@ Boston, MA 02110-1301, USA.  */
 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
index cfd77f2..76e4aef 100644 (file)
@@ -32,9 +32,15 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include <math.h>
 #include <stddef.h>
+#include <limits.h>
 
+#include "config.h"
 #include "libgfortran.h"
 
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
 /* Stupid function to be sure the constructor is always linked in, even
    in the case of static linking.  See PR libfortran/22298 for details.  */
 void
@@ -92,6 +98,44 @@ get_args (int *argc, char ***argv)
 }
 
 
+static const char *exe_path;
+
+/* Save the path under which the program was called, for use in the
+   backtrace routines.  */
+void
+store_exe_path (const char * argv0)
+{
+#ifndef PATH_MAX
+#define PATH_MAX 1024
+#endif
+
+#ifndef DIR_SEPARATOR   
+#define DIR_SEPARATOR '/'
+#endif
+
+  char buf[PATH_MAX], *cwd, *path;
+
+  if (argv0[0] == '/')
+    {
+      exe_path = argv0;
+      return;
+    }
+
+  cwd = getcwd (buf, sizeof (buf));
+
+  /* exe_path will be cwd + "/" + argv[0] + "\0" */
+  path = malloc (strlen (cwd) + 1 + strlen (argv0) + 1);
+  st_sprintf (path, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
+  exe_path = path;
+}
+
+/* Return the full path of the executable.  */
+char *
+full_exe_path (void)
+{
+  return (char *) exe_path;
+}
+
 /* Initialize the runtime library.  */
 
 static void __attribute__((constructor))